view modules/llcompile.tp @ 310:2308336790d4

WIP compiler module for low-level dialect
author Michael Pavone <pavone@retrodev.com>
date Fri, 01 Aug 2014 18:56:39 -0700
parents
children f987bb2a1911
line wrap: on
line source

{
	_compileError <- :_msg _line {
		#{
			isError? <- { true }
			msg <- { _msg }
			line <- { _line }
		}
	}

	_notError <- :vals ifnoterr {
		maybeErr <- vals find: :val {
			(object does: val understand?: "isError?") && val isError?
		}
		maybErr value: :err {
			err
		} none: ifnoterr
	}

	_ilFun <- :_name {
		_buff <- #[]
		_nextReg <- 0
		#{
			name <- { _name }
			add <- :inst { _buff append: inst }
			getReg <- {
				r <- il reg: _nextReg
				_nextReg <- _nextReg + 1
				r
			}
		}
	}

	_exprHandlers <- dict hash
	_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 <- 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" and
	mapOp: "or" or
	mapOp: "xor" xor

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

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

	_exprHandlers set: binary _compileBinary
	_exprHandlers set: stringlit _compileString
	#{
		import: [
			binary
			stringlit
			intlit
			sym
			call
			obj
			sequence
			assignment
			lambda
		] from: ast
		llFun <- :{

		}
	}
}