Mercurial > repos > tabletprog
view modules/llcompile.tp @ 331:61f5b794d939
Breaking change: method call syntax now always uses the syntactic receiver as the actual receiver. This makes its behavior different from function call syntax, but solves some problems with methods being shadowed by local variables and the like.
author | Michael Pavone <pavone@retrodev.com> |
---|---|
date | Sat, 28 Mar 2015 14:21:04 -0700 |
parents | f987bb2a1911 |
children | f74ce841fd1e |
line wrap: on
line source
{ _compileError <- :_msg _line { #{ isError? <- { true } msg <- { _msg } line <- { _line } } } _notError <- :vals ifnoterr { if: (object does: vals understand?: "find") { maybeErr <- vals find: :val { (object does: val understand?: "isError?") && val isError? } maybeErr value: :err { err } none: ifnoterr } else: ifnoterr } _ilFun <- :_name { _buff <- #[] _blockStack <- [] _nextReg <- 0 #{ name <- { _name } add <- :inst { _buff append: inst } getReg <- { r <- il reg: _nextReg _nextReg <- _nextReg + 1 r } startBlock <- { _blockStack <- _buff | _blockStack _buff <- #[] } popBlock <- { res <- _buff _buff <- _blockStack value _blockStack <- _blockStack tail res } buffer <- { _buff } } } _exprHandlers <- false _compileExpr:syms:ilfun:dest <- :expr :syms :ilf :dst { _exprHandlers ifget: (expr nodeType) :handler { handler: expr syms ilf dst } else: { _compileError: "Expression with node type " . (expr nodeType) . " not implemented yet" } } _opMap <- false _compOps <- false _compileBinary <- :expr syms ilf assignTo { _assignSize? <- false _asize <- 0 dest <- option value: assignTo :asn { _assignSize? <- true _asize <- asn size asn } none: { ilf getReg } l <- _compileExpr: (expr left) syms: syms ilfun: ilf assign: (option value: dest) r <- _compileExpr: (expr right) syms: syms ilfun: ilf assign: (option none) _notError: [(l) (r)] { lv <- l val ls <- l size rv <- r val rs <- r size _size <- if: ls > rs { ls } else: { rs } _signed <- (ls signed?) || (rs signed?) _opMap ifget: (expr op) :ingen { ilf add: (ingen: lv rv (dest val) _size) #{ val <- dest size <- _size signed? <- _signed } } else: { _compOps ifget: (expr op) :cond { ilf add: (il bool: cond dest) #{ val <- dest size <- il b signed? <- false } } else: { _compileError: "Operator " . (expr op) . " is not supported yet\n" 0 } } } } _compileString <- :expr syms ilf assignTo { } _compileInt <- :expr syms ilf assignTo { expr } _compileSym <- :expr syms ilf assignTo { syms ifDefined: (expr name) :def { def } else: { _compileError: "Symbol " . (expr name) . " is not defined in " . (ilf name) } } _compileIf <- :expr syms ilf assignTo { if: ((expr args) length) != 2 { _compileError: "if takes exactly 2 arguments" 0 } else: { condArg <- (expr args) value blockArg <- ((expr args) tail) value cond <- _compileExpr: condArg syms: syms ilfun: ilf dest: (option none) _notError: [cond] { if: (blockArg nodeType) != (ast lambda) { _compileError: "second argument to if must be a lambda" } else: { ilf add: (il cmp: condArg 0 (condArg size)) //TODO: Deal with if in return position ilf startBlock foreach: (blockArg expressions) :idx expr{ _compileExpr: expr syms: syms ilfun: ilf dest: (option none) } block <- ilf popBlock ilf add: (il skipIf: (il neq) block) } } } } _compileIfElse <- :expr syms ilf assignTo { if: ((expr args) length) != 2 { _compileError: "if takes exactly 2 arguments" 0 } else: { condArg <- (expr args) value blockArg <- ((expr args) tail) value elseArg <- (((expr args) tail) tail) value cond <- _compileExpr: condArg syms: syms ilfun: ilf dest: (option none) _notError: [cond] { if: (blockArg nodeType) != (ast lambda) { _compileError: "second argument to if:else must be a lambda" } else: { if: (elseArg nodeType) != (ast lambda) { _compileError: "third argument to if:else must be a lambda" } else: { ilf add: (il cmp: condArg 0 (condArg size)) //TODO: Deal with if:else in return position ilf startBlock foreach: (blockArg expressions) :idx expr { _compileExpr: expr syms: syms ilfun: ilf dest: (option none) } block <- ilf popBlock ilf startBlock foreach: (elseArg expressions) :idx expr { _compileExpr: expr syms: syms ilfun: ilf dest: (option none) } elseblock <- ilf popBlock ilf add: (il skipIf: (il neq) block else: elseblock) } } } } } _funMap <- false _compileCall <- :expr syms ilf assignTo { if: ((expr tocall) nodeType) = (ast sym) && (_funMap contains?: ((expr tocall) name)) { handler <- _funMap get: ((expr tocall) name) else: { false } handler: expr syms ilf assignTo } else: { ctocall <- _compileExpr: (expr tocall) syms: syms ilfuN: ilf dest: (option none) cargs <- (expr args) map: :arg { _compileExpr: arg syms: syms ilfun: ilf dest: (option none) } _notError: ctocall | cargs { ilf add: (il call: ctocall withArgs: cargs) il retr } } } _compileAssign <- :expr syms ilf assignTo { dest <- _compileExpr: (expr to) syms: syms ilfun: ilf dest: (option none) _notError: [dest] { value <- _compileExpr: (expr assign) syms: syms ilfun: ilf dest: dest _notError: [value] { //TODO: adjust size of value if necessary ilf add: (il mov: (value val) (dest val) (dest size)) value } } } _initDone? <- false #{ import: [ binary stringlit intlit sym call obj sequence assignment lambda ] from: ast _initHandlers <- { if: (not: _initDone?) { _exprHandlers <- dict hash _exprHandlers set: binary _compileBinary _exprHandlers set: stringlit _compileString _exprHandlers set: intlit _compileInt _exprHandlers set: sym _compileSym _exprHandlers set: assignment _compileAssign _exprHandlers set: call _compileCall _opMap <- dict hash mapOp <- macro: :op ilfun { quote: (_opMap set: op :ina inb out size { il ilfun: ina inb out size }) } mapOp: "+" add mapOp: "-" sub mapOp: "*" mul mapOp: "/" div mapOp: "and" band mapOp: "or" bor mapOp: "xor" bxor _compOps <- dict hash _compOps set: "=" :signed? { il eq } _compOps set: "!=" :signed? { il ne } _compOps set: ">" :signed? { if: signed? { il gr } else: { il ugr } } _compOps set: "<" :signed? { if: signed? { il ls } else: { il uls } } _compOps set: ">=" :signed? { if: signed? { il ge } else: { il uge } } _compOps set: "<=" :signed? { if: signed? { il le } else: { il ule } } _funMap <- dict hash _funMap set: "if" _compileIf _funMap set: "if:else" _compileIfElse //_funMap set: "while:do" _compileWhileDo } } llFun:syms:vars:code <- :name :syms :vars :code{ _initHandlers: syms <- symbols tableWithParent: syms argnames <- dict hash foreach: (code args) :idx arg { if: (arg startsWith?: ":") { arg <- arg from: 1 } argnames set: arg true } ilf <- _ilFun: name _nextReg <- 0 foreach: vars :idx var { type <- _parseType: (var assign) varname <- ((var to) name) v <- argnames ifget: varname :argnum { il arg: argnum } else: { ilf getReg } syms define: varname #{ val <- v size <- (type size) } } last <- option none numexprs <- code length foreach: code :idx expr { asn <- option none if: idx = numexprs - 1 { option value: (il retr) } last <- option value: (_compileExpr: expr syms: syms ilfun: ilf dest: asn) } last value: :v { ilf add: (il return: (v val) (v size)) } none: { ilf add: (il return: 0 (il l)) } ilf } compileText <- :text { res <- parser top: text if: res { tree <- res yield if: (tree nodeType) = obj { errors <- [] syms <- symbols table functions <- tree messages fold: [] :curfuncs msg { if: (msg nodeType) = call { if: ((msg tocall) name) = "llFun:withVars:andCode" { if: ((msg args) length) = 3 { fname <- ((msg args) get: 0) name syms define: fname #{ type <- "topfun" } #{ name <- fname vars <- (msg args) get: 1 body <- (msg args) get: 2 } | curfuncs } else: { errors <- ( _compileError: "llFun:withVars:andCode takes exactly 3 arguments" 0 ) | errors curfuncs } } else: { errors <- ( _compileError: "Only llFun:withVars:andCode expressions are allowed in top level object" 0 ) | errors curfuncs } } else: { errors <- ( _compileError: "Only call expresions are allowed in top level object" 0 ) | errors curfuncs } } if: (errors empty?) { fmap <- functions fold: (dict hash) with: :acc func { _notError: acc { ilf <- llFun: (func name) syms: syms vars: (func vars) code: (func body) _notError: ilf { acc set: (func name) (ilf buffer) } } } fmap toBackend: x86 } else: { errors } } else: { [(_compileError: "Top level must be an object in llcompile dialect" 1)] } } else: { [(_compileError: "Failed to parse file" 0)] } } main <- :args { if: (length: args) > 1 { text <- (file open: (args get: 1)) readAll mcode <- compileText: text _notError: mcode { ba <- bytearray executableFromBytes: mcode arg <- if: (length: args) > 2 { int32: (args get: 2) } else: {0} ba runWithArg: (arg i64) } } else: { (file stderr) write: "Usage: llcompile FILE\n" 1 } } } }