Mercurial > repos > icfp2014
view code/gqc.tp @ 58:d35601d47db1
Implement if:else in gqc
author | Michael Pavone <pavone@retrodev.com> |
---|---|
date | Sun, 27 Jul 2014 20:03:34 -0700 |
parents | fde898a3cbbe |
children | 2a5d7308e1df |
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 { (not: (reg?: other)) || _num != (other num) } = <- :other { (reg?: other) && _num = (other num) } } } inst <- :_name _args { #{ name <- _name args <- _args translateLabels <- :labelDict { missing <- #[] args <- args map: :arg { if: (object does: arg understand?: "isString?") && (arg isString?) { labelDict get: arg else: { missing append: arg arg } } else: { 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 _allTemp <- [ reg: 2 reg: 3 reg: 4 reg: 5 reg: 6 ] _tempRegs <- _allTemp _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 } _funHandlers <- dict hash //provide symbolic names for all the interupt routines _funHandlers set: "debug" :args syms { prog add: (inst: "INT" #[8]) 0 } _funHandlers set: "direction!" :args syms { dir <- args value startTempRegs <- _tempRegs v <- compileExpr: dir syms: syms _tempRegs <- startTempRegs if: (reg: 0) != v { prog add: (inst: "MOV" #[ reg: 0 v ]) } prog add: (inst: "INT" #[0]) 0 } _funHandlers set: "lambdamanPos" :args syms { prog add: (inst: "INT" #[1]) reg: 0 } _funHandlers set: "lambdaman2Pos" :args syms { prog add: (inst: "INT" #[2]) reg: 0 } _funHandlers set: "me" :args syms { prog add: (inst: "INT" #[3]) reg: 0 } foreach: #["ghostStartPos" "ghostPos" "ghostStatus"] :idx name { intNum <- idx + 4 _funHandlers set: name :args syms { ghostIdx <- args value startTempRegs <- _tempRegs v <- compileExpr: ghostIdx syms: syms _tempRegs <- startTempRegs if: (reg: 0) != v { prog add: (inst: "MOV" #[ reg: 0 v ]) } prog add: (inst: "INT" #[intNum]) reg: 0 } } _funHandlers set: "mapContentsAt" :args syms { x <- args value y <- (args tail) value startTempRegs <- _tempRegs x <- compileExpr: x syms: syms y <- compileExpr: y syms: syms _tempRegs <- startTempRegs if: (reg: 0) != x { prog add: (inst: "MOV" #[ reg: 0 x ]) } if: (reg: 1) != y { prog add: (inst: "MOV" #[ reg: 1 y ]) } prog add: (inst: "INT" #[7]) reg: 0 } //allow access to raw instructions foreach: #["MOV" "INC" "DEC" "ADD" "SUB" "MUL" "DIV" "AND" "OR" "XOR" "JLT" "JEQ" "JGT" "HLT"] :idx instName { _funHandlers set: instName :args syms { saveTempRegs <- _tempRegs args <- args map: :arg { compileExpr: arg syms: syms } prog add: (inst: instName args) } } _funHandlers set: "while:do" :args syms { cond <- ((args value) expressions) value body <- ((args tail) value) expressions if: (cond nodeType) = (ast binary) { top <- prog makeLabel: "loop_top" end <- prog makeLabel: "loop_end" prog setLabel: top saveTempRegs <- _tempRegs l <- compileExpr: (cond left) syms: syms r <- compileExpr: (cond right) syms: syms _tempRegs <- saveTempRegs ok <- true //we need the inverse check in the instruction since a true condition //means continue the loop, whereas we need a jump instruction that jumps //only when it is time to exit if: (cond op) = ">=" { prog add: (inst: "JLT" #[ end l r ]) } else: { if: (cond op) = "<=" { prog add: (inst: "JGT" #[ end l r ]) } else: { if: (cond op) = "!=" { prog add: (inst: "JEQ" #[ end l r ]) } else: { if: (cond op) = ">" { bodyLbl <- prog makeLabel: "loop_body" prog add: (inst: "JGT" #[ bodyLbl l r ]) prog add: (inst: "MOV" #[ reg: 8 end ]) prog setLabel: bodyLbl } else: { if: (cond op) = "<" { bodyLbl <- prog makeLabel: "loop_body" prog add: (inst: "JLT" #[ bodyLbl l r ]) prog add: (inst: "MOV" #[ reg: 8 end ]) prog setLabel: bodyLbl } else: { bodyLbl <- prog makeLabel: "loop_body" if: (cond op) = "=" { prog add: (inst: "JEQ" #[ bodyLbl l r ]) prog add: (inst: "MOV" #[ reg: 8 end ]) prog setLabel: bodyLbl } else: { ok <- false } } } } } } if: ok { //TODO: do 2 passes for labels to allow forward references foreach: body :idx expr { if: (expr nodeType) = (ast sym) { //allow using bare symbols to define labels lbl <- prog makeLabel: (expr name) prog setLabel: lbl syms define: (expr name) lbl } else: { saveTempRegsExpr <- _tempRegs v <- compileExpr: expr syms: syms _tempRegs <- saveTempRegsExpr } } prog add: (inst: "MOV" #[ reg: 8 top ]) prog setLabel: end } else: { error: "Condition parameter to while:do must be a comparison operator expression" } } else: { error: "Condition parameter to while:do must be a comparison operator expression" } } _funHandlers set: "if:else" :args syms { cond <- (args value) trueBody <- ((args tail) value) expressions falseBody <- (((args tail) tail) value) expressions if: (cond nodeType) = (ast binary) { trueLbl <- prog makeLabel: "true" falseLbl <- prog makeLabel: "false" endLbl <- prog makeLabel: "end" saveTempRegs <- _tempRegs l <- compileExpr: (cond left) syms: syms r <- compileExpr: (cond right) syms: syms _tempRegs <- saveTempRegs ok <- true if: (cond op) = ">=" { prog add: (inst: "JLT" #[ falseLbl l r ]) } else: { if: (cond op) = "<=" { prog add: (inst: "JGT" #[ falseLbl l r ]) } else: { if: (cond op) = "!=" { prog add: (inst: "JEQ" #[ falseLbl l r ]) } else: { if: (cond op) = ">" { prog add: (inst: "JGT" #[ trueLbl l r ]) prog add: (inst: "MOV" #[ reg: 8 falseLbl ]) } else: { if: (cond op) = "<" { prog add: (inst: "JLT" #[ trueLbl l r ]) prog add: (inst: "MOV" #[ reg: 8 falseLbl ]) } else: { bodyLbl <- prog makeLabel: "loop_body" if: (cond op) = "=" { prog add: (inst: "JEQ" #[ trueLbl l r ]) prog add: (inst: "MOV" #[ reg: 8 falseLbl ]) } else: { ok <- false } } } } } } if: ok { prog setLabel: trueLbl //TODO: do 2 passes for labels to allow forward references foreach: trueBody :idx expr { if: (expr nodeType) = (ast sym) { //allow using bare symbols to define labels lbl <- prog makeLabel: (expr name) prog setLabel: lbl syms define: (expr name) lbl } else: { saveTempRegsExpr <- _tempRegs v <- compileExpr: expr syms: syms _tempRegs <- saveTempRegsExpr } } prog add: (inst: "MOV" #[ reg: 8 endLbl ]) prog setLabel: falseLbl //TODO: do 2 passes for labels to allow forward references foreach: falseBody :idx expr { if: (expr nodeType) = (ast sym) { //allow using bare symbols to define labels lbl <- prog makeLabel: (expr name) prog setLabel: lbl syms define: (expr name) lbl } else: { saveTempRegsExpr <- _tempRegs v <- compileExpr: expr syms: syms _tempRegs <- saveTempRegsExpr } } prog setLabel: endLbl } else: { error: "Condition parameter to if:else must be a comparison operator expression" } } else: { error: "Condition parameter to if:else must be a comparison operator expression" } } _exprHandlers set: (ast call) :expr syms { tc <- (expr tocall) if: (tc nodeType) = (ast sym) { _funHandlers ifget: (tc name) :handler { handler: (expr args) syms } else: { syms ifDefined: (tc name) :info { saveTempRegs <- _tempRegs funArgs <- (expr args) map: :arg { compileExpr: arg syms: syms} _tempRegs <- saveTempRegs //save registers that need it needSave <- _allTemp filter: :r { not: (_tempRegs contains?: r) } foreach: needSave :idx r { prog add: (inst: "DEC" #[(reg: 7)]) prog add: (inst: "MOV" #[ mem: (reg: 7) r ]) } after <- prog makeLabel: "after_call" //save PC value after call prog add: (inst: "DEC" #[(reg: 7)]) prog add: (inst: "MOV" #[ mem: (reg: 7) after ]) //put arguments into the appropriate registers passregs <- _allTemp foreach: funArgs :idx arg { passreg <- passregs value passregs <- passregs tail if: passreg != arg { //there's a potential for clobbering argument temp regs //but there's no time to figure out a good solution prog add: (inst: "MOV" #[ passreg arg ]) } else: { print: "Skipping MOV for argument: " . arg . "\n" } } //jump to function prog add: (inst: "MOV" #[ reg: 8 info def ]) prog setLabel: after //adjust PC prog add: (inst: "INC" #[(reg: 7)]) //restore registers that were saved earlier foreach: (reverse: needSave) :idx r { prog add: (inst: "MOV" #[ r mem: (reg: 7) ]) prog add: (inst: "INC" #[(reg: 7)]) } reg: 0 } else: { error: "Function " . (tc name) . " is not defined" } } } else: { error: "Calling expressions is not supported in" } } _compileFun <- :fName fun globsyms { syms <- symbols tableWithParent: globsyms saveTempRegs <- _tempRegs foreach: (fun args) :idx arg { argname <- (if: (arg startsWith?: ":") { arg from: 1 } else: { arg }) r <- _tempRegs value _tempRegs <- _tempRegs tail syms define: argname r } lastexpr <- ((fun expressions) length) - 1 //TODO: do 2 passes for labels to allow forward references foreach: (fun expressions) :idx expr { if: idx != lastexpr && (expr nodeType) = (ast sym) { //allow using bare symbols to define labels prog setLabel: (expr name) syms define: (expr name) (expr name) } else: { saveTempRegsExpr <- _tempRegs v <- compileExpr: expr syms: syms _tempRegs <- saveTempRegsExpr if: idx = lastexpr && (fName != "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 //define symbols for all registers //for low level shenanigans i <- 0 while: { i < 9 } do: { r <- reg: i syms define: (string: r) r i <- i + 1 } //define symbols for interrupt return values syms define: "xCoord" (reg: 0) syms define: "yCoord" (reg: 1) syms define: "vitality" (reg: 0) syms define: "direction" (reg: 1) //process top level assignments 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 _compileFun: 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" } } } }