{ _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 } } } }