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