pavone@239: {
pavone@256: 	_matchid <- 0
pavone@256: 	getMatchId <- {
pavone@256: 		id <- _matchid
pavone@256: 		_matchid <- _matchid + 1
pavone@256: 		id
pavone@256: 	}
pavone@256: 	matchMemo <- {
pavone@256: 		_posdata <- #[]
pavone@256: 		_checkInitData <- :len {
pavone@256: 			len <- len + 1
pavone@256: 			while: { (_posdata length) < len } do: {
pavone@256: 				_posdata append: (dict hash)
pavone@256: 			}
pavone@256: 		}
pavone@256: 		#{
pavone@256: 			memo:at:withId:length <- :val :at :id :len {
pavone@256: 				_checkInitData: len
pavone@256: 				(_posdata get: at) set: id val
pavone@256: 				self
pavone@256: 			}
pavone@256: 			
pavone@256: 			getMemo:at:else <- :id :at :else {
pavone@256: 				if: (_posdata length) > at {
pavone@256: 					(_posdata get: at) ifget: id :val {
pavone@256: 						val
pavone@256: 					} else: else
pavone@256: 				} else: else
pavone@256: 			}
pavone@256: 		}
pavone@256: 	}
pavone@243: light:from:withLength <- :_base :_start :_len {
pavone@256: 	_matchmemo <- matchMemo:
pavone@243: 	if: (not: (_base isBasicString?)) {
pavone@243: 		_start <- _start + (_base start)
pavone@256: 		_matchmemo <- _base memoData
pavone@243: 		_base <- _base base
pavone@243: 	}
pavone@243: 	_needsflat? <- true
pavone@243: 	_flat <- false
pavone@243: 	#{
pavone@243: 		//TODO: UTF-8 support
pavone@243: 		length <- { _len }
pavone@243: 		byte_length <- { _len }
pavone@243: 		string <- {
pavone@243: 			if: _needsflat? {
pavone@252: 				_needsflat? <- false
pavone@243: 				_flat <- _base from: _start withLength: _len
pavone@243: 			}
pavone@243: 			_flat
pavone@243: 		}
pavone@243: 		from:withLength <- :s :l {
pavone@243: 			if: (l + s) > _len {
pavone@243: 				l <- _len - s
pavone@243: 			}
pavone@243: 			_base from: (_start + s) withLength: l
pavone@243: 		}
pavone@243: 		from <- :s {
pavone@243: 			from: s withLength: (_len - s)
pavone@243: 		}
pavone@243: 		byte <- :index {
pavone@243: 			_base byte: (index + _start)
pavone@243: 		}
pavone@243: 		= <- :other {
pavone@243: 			if: (other length) = _len {
pavone@243: 				ostart <- 0
pavone@243: 				if: (not: (other isBasicString?)) {
pavone@243: 					ostart <- other start
pavone@243: 					other <- other _base
pavone@243: 				}
pavone@243: 				res <- _base compareSub: other _start ostart _len
pavone@243: 				res = 0
pavone@243: 			}
pavone@243: 		}
pavone@243: 		. <- :other {
pavone@243: 			(string: self) . other
pavone@243: 		}
pavone@243: 		int32 <- {
pavone@243: 			(string: self) int32
pavone@243: 		}
pavone@243: 		splitOn <- :delim {
pavone@243: 			(string: self) splitOn: delim
pavone@243: 		}
pavone@243: 		isString? <- { true }
pavone@243: 		isBasicString? <- { false }
pavone@243: 		base <- { _base }
pavone@243: 		start <- { _start }
pavone@256: 		memoData <- { _matchmemo }
pavone@256: 		
pavone@256: 		memo:at:withId <- :val :at :id {
pavone@256: 			_matchmemo memo: val at: (at + _start) withId: id length: (_base length)
pavone@256: 			self
pavone@256: 		}
pavone@256: 		
pavone@256: 		getMemo:at:else <- :id :at :else {
pavone@256: 			_matchmemo getMemo: id at: (at + _start) else: else
pavone@256: 		}
pavone@243: 	}
pavone@243: }
pavone@243: 
pavone@243: light:from <- :base :start {
pavone@243: 	light: base from: start withLength: (base length) - start
pavone@243: }
pavone@239: _applyMatch <- :fun tomatch {
pavone@209: 		fun: tomatch
pavone@209: 	}
pavone@239: _matchString <- :str tomatch {
pavone@239: 	if: (tomatch isString?) {
pavone@239: 		if: (tomatch length) < (str length) {
pavone@242: 			false
pavone@239: 		} else: {
pavone@239: 			if: (tomatch length) > (str length) {
pavone@239: 				tomatch <- tomatch from: 0 withLength: (str length)
pavone@239: 			}
pavone@243: 			if: tomatch = str {
pavone@239: 				#{
pavone@242: 					if <- :self trueblock {
pavone@242: 						trueblock:
pavone@242: 					}
pavone@242: 					ifnot <- :self falseblock {
pavone@242: 						self
pavone@242: 					}
pavone@242: 					if:else <- :self trueblock :elseblock {
pavone@242: 						trueblock:
pavone@242: 					}
pavone@239: 					matchlen <- { str length }
pavone@239: 					basicYield? <- { true }
pavone@239: 					yield <- { str }
pavone@239: 				}
pavone@239: 			} else: {
pavone@242: 				false
pavone@239: 			}
pavone@239: 		}
pavone@239: 	} else: {
pavone@242: 		false
pavone@239: 	}
pavone@239: }
pavone@239: _makeMatchCall <- :matchexpr {
pavone@239: 	if: (matchexpr nodeType) = "lambda" {
pavone@239: 		#{
pavone@239: 			valid? <- { true }
pavone@239: 			matchcall <- quote: (_applyMatch: matchexpr tomatch)
pavone@239: 		}
pavone@239: 	} else: {
pavone@239: 		if: (matchexpr nodeType) = "symbol" {
pavone@239: 			#{
pavone@239: 				valid? <- { true }
pavone@239: 				matchcall <- quote: (matchexpr: tomatch)
pavone@239: 			}
pavone@239: 		} else: {
pavone@239: 			if: (matchexpr nodeType) = "strlit" {
pavone@239: 				#{
pavone@239: 					valid? <- { true }
pavone@239: 					matchcall <- quote: (_matchString: matchexpr tomatch)
pavone@212: 				}
pavone@239: 			} else: {
pavone@239: 				if: (matchexpr nodeType) = "op" {
pavone@239: 					if: (matchexpr opName) = "." {
pavone@239: 						left <- (_makeMatchCall: (matchexpr left)) matchcall
pavone@239: 						right <- (_makeMatchCall: (matchexpr right)) matchcall
pavone@239: 						#{
pavone@239: 							valid? <- { true }
pavone@239: 							matchcall <- quote: (_applyMatch: :tomatch {
pavone@239: 								lm <- left
pavone@242: 								if: lm {
pavone@239: 									orig <- tomatch
pavone@243: 									tomatch <- light: tomatch from: (lm matchlen)
pavone@239: 									rm <- right
pavone@242: 									if: rm {
pavone@239: 										total <- (rm matchlen) + (lm matchlen)
pavone@239: 										#{
pavone@242: 											if <- :self trueblock {
pavone@242: 												trueblock:
pavone@242: 											}
pavone@242: 											ifnot <- :self falseblock {
pavone@242: 												self
pavone@242: 											}
pavone@242: 											if:else <- :self trueblock :elseblock {
pavone@242: 												trueblock:
pavone@242: 											}
pavone@239: 											matchlen <- { total }
pavone@239: 											basicYield? <- { true }
pavone@239: 											yield <- { orig from: 0 withLength: total }
pavone@239: 										}
pavone@239: 									} else: {
pavone@239: 										rm
pavone@239: 									}
pavone@239: 								} else: {
pavone@239: 									lm
pavone@239: 								}
pavone@239: 							} tomatch)
pavone@239: 						}
pavone@239: 					} else: {
pavone@239: 						#{
pavone@239: 							valid? <- { false }
pavone@239: 							message <- "Unsupported operator " . (matchexpr opName)
pavone@239: 						}
pavone@212: 					}
pavone@212: 				} else: {
pavone@212: 					#{
pavone@239: 						valid? <- { false }
pavone@239: 						message <- "Unsupported AST node type " . (matchexpr nodeType)
pavone@239: 					}
pavone@239: 				}
pavone@239: 			}
pavone@239: 		}
pavone@239: 	}
pavone@239: }
pavone@239: _nPlus <- :matchexpr min {
pavone@239: 	funexpr <- false
pavone@239: 	valid <- false
pavone@239: 	mc <- _makeMatchCall: matchexpr
pavone@239: 	if: (mc valid?) {
pavone@239: 		mcall <- mc matchcall
pavone@239: 		quote: :tomatch {
pavone@239: 			cur <- 0
pavone@239: 			count <- 0
pavone@239: 			n <- tomatch byte_length
pavone@239: 			orig <- tomatch
pavone@239: 			_match <- true
pavone@239: 			allBasic? <- true
pavone@239: 			yieldvals <- []
pavone@239: 			while: { _match && cur < n } do: {
pavone@239: 				res <- mcall
pavone@242: 				_match <- if: res {
pavone@239: 					count <- count + 1
pavone@239: 					//TODO: Use some kind of lightweight substring wrapper here
pavone@243: 					tomatch <- light: tomatch from: (res matchlen)
pavone@239: 					if: allBasic? {
pavone@239: 						ifnot: (res basicYield?) {
pavone@239: 							allBasic? <- false
pavone@239: 							if: cur > 0 {
pavone@239: 								yieldvals <- (orig from: 0 withLength: cur) | yieldvals
pavone@239: 							}
pavone@239: 							yieldvals <- (res yield) | yieldvals
pavone@239: 						}
pavone@239: 					} else: {
pavone@239: 						yieldvals <- (res yield) | yieldvals
pavone@239: 					}
pavone@239: 					allBasic? <- allBasic? && (res basicYield?)
pavone@239: 					cur <- cur + (res matchlen)
pavone@242: 					true
pavone@239: 				}
pavone@239: 			}
pavone@239: 			if: count >= min {
pavone@239: 				if: allBasic? {
pavone@239: 					#{
pavone@242: 						if <- :self trueblock {
pavone@242: 							trueblock:
pavone@242: 						}
pavone@242: 						ifnot <- :self falseblock {
pavone@242: 							self
pavone@242: 						}
pavone@242: 						if:else <- :self trueblock :elseblock {
pavone@242: 							trueblock:
pavone@242: 						}
pavone@239: 						matchlen <- { cur }
pavone@239: 						basicYield? <- { true }
pavone@239: 						yield <- { orig from: 0 withLength: cur }
pavone@239: 					}
pavone@239: 				} else: {
pavone@239: 					yieldvals <- yieldvals reverse
pavone@239: 					#{
pavone@242: 						if <- :self trueblock {
pavone@242: 							trueblock:
pavone@242: 						}
pavone@242: 						ifnot <- :self falseblock {
pavone@242: 							self
pavone@242: 						}
pavone@242: 						if:else <- :self trueblock :elseblock {
pavone@242: 							trueblock:
pavone@242: 						}
pavone@239: 						matchlen <- { cur }
pavone@239: 						basicYield? <- { false }
pavone@239: 						yield <- { yieldvals }
pavone@212: 					}
pavone@212: 				}
pavone@239: 			} else: {
pavone@242: 				false
pavone@239: 			}
pavone@239: 		}
pavone@239: 	} else: {
pavone@239: 		print: "#error Invalid nPlus macro call: " . (mc message) . "\n"
pavone@239: 	}
pavone@239: }
pavone@239: _expandClass <- :chars {
pavone@239: 	if: (chars length) > 0 {
pavone@239: 		pos <- 0
pavone@239: 		inverted <- false
pavone@239: 		if: (chars byte: 0) = ("^" byte: 0) {
pavone@239: 			pos <- 1
pavone@239: 			inverted <- true
pavone@239: 		}
pavone@239: 		state_begin <- 0
pavone@239: 		state_normal <- 1
pavone@239: 		state_rangeend <- 2
pavone@239: 		state <- state_begin
pavone@239: 		out <- ""
pavone@239: 		while: { pos < (chars byte_length)} do: {
pavone@239: 			if: state = state_begin {
pavone@239: 				out <- out . (chars from: pos withLength: 1)
pavone@239: 				state <- state_normal
pavone@239: 			} else: {
pavone@239: 				if: state = state_normal {
pavone@239: 					if: (chars byte: pos) = ("-" byte: 0) {
pavone@239: 						state <- state_rangeend
pavone@239: 					} else: {
pavone@239: 						out <- out . (chars from: pos withLength: 1)
pavone@239: 					}
pavone@239: 				} else: {
pavone@239: 					rangestart <- out byte: ((out byte_length) - 1)
pavone@239: 					rangeend <- chars byte: pos
pavone@239: 					if: rangeend < rangestart {
pavone@239: 						tmp <- rangeend
pavone@239: 						rangeend <- rangestart
pavone@239: 						rangestart <- tmp
pavone@239: 					}
pavone@239: 					out <- out from: 0 withLength: ((out length) - 1)
pavone@239: 					while: { rangestart <= rangeend } do: {
pavone@239: 						out <- out . (rangestart asStringChar)
pavone@239: 						rangestart <- rangestart + 1
pavone@239: 					}
pavone@239: 					state <- state_begin
pavone@239: 				}
pavone@239: 			}
pavone@239: 			pos <- pos + 1
pavone@239: 		}
pavone@239: 		if: inverted {
pavone@239: 			old <- out
pavone@239: 			out <- ""
pavone@245: 			cur <- 0
pavone@239: 			while: { cur < 256 } do: {
pavone@239: 				notfound <- true
pavone@239: 				idx <- 0
pavone@239: 				len <- (old length)
pavone@239: 				while: { notfound && idx < len } do: {
pavone@239: 					if: cur = (old byte: idx) {
pavone@239: 						notfound <- false
pavone@239: 					} else: {
pavone@239: 						idx <- idx + 1
pavone@239: 					}
pavone@239: 				}
pavone@239: 				if: notfound {
pavone@239: 					out <- out . (cur asStringChar)
pavone@239: 				}
pavone@239: 				cur <- cur + 1
pavone@239: 			}
pavone@239: 		}
pavone@239: 		out
pavone@239: 	} else: {
pavone@239: 		""
pavone@239: 	}
pavone@239: }
pavone@239: _charClass <- :chars {
pavone@242: 	orig <- chars
pavone@239: 	chars <- _expandClass: chars
pavone@239: 	charmap <- ""
pavone@239: 	char <- 0
pavone@239: 	while: { char < 256 } do: {
pavone@239: 		mchar <- 0
pavone@239: 		found <- false
pavone@239: 		while: { mchar < (chars byte_length)} do: {
pavone@239: 			if: (chars byte: mchar) = char {
pavone@239: 				found <- true
pavone@239: 				mchar <- chars byte_length
pavone@239: 			}
pavone@239: 			mchar <- mchar + 1
pavone@239: 		}
pavone@239: 		charmap <- charmap . (if: found { "t" } else: { "f" })
pavone@239: 		char <- char + 1
pavone@239: 	}
pavone@239: 	t <- "t" byte: 0
pavone@239: 	quote: :tomatch {
pavone@239: 		if: (tomatch isString?) {
pavone@239: 			if: (charmap byte: (tomatch byte: 0)) = t {
pavone@239: 				#{
pavone@242: 					if <- :self trueblock {
pavone@242: 						trueblock:
pavone@242: 					}
pavone@242: 					ifnot <- :self falseblock {
pavone@242: 						self
pavone@242: 					}
pavone@242: 					if:else <- :self trueblock :elseblock {
pavone@242: 						trueblock:
pavone@242: 					}
pavone@239: 					matchlen <- { 1 }
pavone@239: 					basicYield? <- { true }
pavone@239: 					yield <- { tomatch from: 0 withLength: 1 }
pavone@239: 				}
pavone@239: 			} else: {
pavone@242: 				false
pavone@212: 			}
pavone@212: 		} else: {
pavone@242: 			false
pavone@212: 		}
pavone@212: 	}
pavone@239: }
pavone@239: #{
pavone@208: 	charClass <- macro: :rawchars {
pavone@208: 		eval: rawchars :chars {
pavone@239: 			_charClass: chars
pavone@208: 		} else: {
pavone@212: 			print: "#error Argument to charClass macro must be a compile-time constant\n"
pavone@208: 		}
pavone@208: 	}
pavone@209: 
pavone@220: 	zeroPlus <- macro: :matchexpr {
pavone@220: 		_nPlus: matchexpr 0
pavone@220: 	}
pavone@220: 
pavone@220: 	onePlus <- macro: :matchexpr {
pavone@220: 		_nPlus: matchexpr 1
pavone@220: 	}
pavone@220: 
pavone@212: 	matchOne <- macro: :options {
pavone@256: 		myid <- getMatchId:
pavone@212: 		options <- (options value) map: :option {
pavone@212: 			_makeMatchCall: option
pavone@212: 		}
pavone@242: 		body <- options foldr: (quote: false) with: :acc el {
pavone@212: 			if: (el valid?) {
pavone@212: 				mcall <- el matchcall
pavone@242: 				quote: (ifnot: mcall { acc })
pavone@212: 			} else: {
pavone@212: 				print: "#error Invalid matchOne macro call: " . (el message) . "\n"
pavone@212: 				acc
pavone@212: 			}
pavone@212: 		}
pavone@212: 		quote: :tomatch {
pavone@256: 			tomatch <- light: tomatch from: 0
pavone@256: 			tomatch getMemo: myid at: 0 else: {
pavone@256: 				ret <- body
pavone@256: 				tomatch memo: ret at: 0 withId: myid
pavone@256: 				ret
pavone@256: 			}
pavone@209: 		}
pavone@209: 	}
pavone@209: 
pavone@222: 	match <- macro: :matchexpr {
pavone@222: 		mc <- _makeMatchCall: matchexpr
pavone@222: 		if: (mc valid?) {
pavone@222: 			mcall <- mc matchcall
pavone@222: 			quote: :tomatch {
pavone@222: 				mcall
pavone@222: 			}
pavone@222: 		} else: {
pavone@222: 			print: "#error Invalid macth macro call: " . (mc message) . "\n"
pavone@222: 		}
pavone@222: 	}
pavone@222: 
pavone@213: 	match:yield <- macro: :matchexpr :ylambda {
pavone@213: 		mc <- _makeMatchCall: matchexpr
pavone@213: 		if: (mc valid?) {
pavone@213: 			mcall <- mc matchcall
pavone@213: 			quote: :tomatch {
pavone@213: 				res <- mcall
pavone@242: 				if: res {
pavone@213: 					#{
pavone@242: 						if <- :self trueblock {
pavone@242: 							trueblock:
pavone@242: 						}
pavone@242: 						ifnot <- :self falseblock {
pavone@242: 							self
pavone@242: 						}
pavone@242: 						if:else <- :self trueblock :elseblock {
pavone@242: 							trueblock:
pavone@242: 						}
pavone@213: 						matchlen <- { res matchlen }
pavone@213: 						basicYield? <- { false }
pavone@213: 						yield <- ylambda
pavone@213: 					}
pavone@213: 				} else: {
pavone@213: 					res
pavone@213: 				}
pavone@213: 			}
pavone@213: 		} else: {
pavone@213: 			print: "#error Invalid macth:yield macro call: " . (mc message) . "\n"
pavone@213: 		}
pavone@213: 	}
pavone@213: 
pavone@218: 	match:where:yield <- macro: :matchexpr :whereclause :ylambda {
pavone@256: 		myid <- getMatchId:
pavone@218: 		syms <- []
pavone@256: 		withwhere <- (whereclause expressions) fold: (quote: {}) with: :acc el {
pavone@218: 
pavone@218: 			if: (el nodeType) = "assignment" {
pavone@218: 				valassign <- quote: (val <- false)
pavone@218: 				valsym <- (valassign) symbol
pavone@218: 				valsym <- valsym name!: (valsym name) . ((el symbol) name)
pavone@218: 				valassign <- valassign symbol!: valsym
pavone@218: 				acc addExpression: valassign
pavone@218: 
pavone@218: 				matchassign <- quote: (hasmatch <- false)
pavone@218: 				matchsym <- (matchassign) symbol
pavone@218: 				matchsym <- matchsym name!: (matchsym name) . ((el symbol) name)
pavone@218: 				matchassign <- matchassign symbol!: matchsym
pavone@218: 				acc addExpression: matchassign
pavone@218: 
pavone@218: 				mc <- _makeMatchCall: (el expression)
pavone@218: 
pavone@218: 				if: (mc valid?) {
pavone@218: 					mcall <- mc matchcall
pavone@218: 					matchfun <- quote: :tomatch {
pavone@218: 						if: matchsym {
pavone@218: 							if: valsym = tomatch {
pavone@218: 								#{
pavone@242: 									if <- :self trueblock {
pavone@242: 										trueblock:
pavone@242: 									}
pavone@242: 									ifnot <- :self falseblock {
pavone@242: 										self
pavone@242: 									}
pavone@242: 									if:else <- :self trueblock :elseblock {
pavone@242: 										trueblock:
pavone@242: 									}
pavone@218: 									matchlen <- { valsym length }
pavone@218: 									basicYield? <- { true } //TODO: Check if this is correct
pavone@218: 									yield <- { valsym }
pavone@218: 								}
pavone@218: 							} else: {
pavone@242: 								false
pavone@218: 							}
pavone@218: 						} else: {
pavone@218: 							mr <- mcall
pavone@242: 							if: mr {
pavone@218: 								matchsym <- true
pavone@218: 								valsym <- (mr yield)
pavone@218: 							}
pavone@218: 							mr
pavone@218: 						}
pavone@218: 					}
pavone@218: 					acc <- acc addExpression: (el expression!: matchfun)
pavone@218: 					syms <- list node: #{
pavone@218: 						orig <- el symbol
pavone@218: 						matchval <- valsym
pavone@218: 					} withTail: syms
pavone@218: 					acc
pavone@218: 				} else: {
pavone@218: 					print: "#error " . ((el symbol) name) . " does not have a valid match expression: " . (mc message) . "\n"
pavone@218: 				}
pavone@218: 
pavone@218: 			} else: {
pavone@218: 				print: "#error Nodes of type " . (el nodeType) . " are not allowed in match where clauses\n"
pavone@218: 				acc
pavone@218: 			}
pavone@218: 		}
pavone@218: 		mcMain <- _makeMatchCall: matchexpr
pavone@218: 		if: (mcMain valid?) {
pavone@218: 			mcall <- mcMain matchcall
pavone@218: 			withwhere addExpression: (quote: (matchres <- mcall))
pavone@218: 			successLambda <- quote: {
pavone@218: 				//Extra assignments will be added here
pavone@218: 				mlen <- matchres matchlen
pavone@218: 				#{
pavone@242: 					if <- :self trueblock {
pavone@242: 						trueblock:
pavone@242: 					}
pavone@242: 					ifnot <- :self falseblock {
pavone@242: 						self
pavone@242: 					}
pavone@242: 					if:else <- :self trueblock :elseblock {
pavone@242: 						trueblock:
pavone@242: 					}
pavone@218: 					matchlen <- { mlen }
pavone@218: 					basicYield? <- { false }
pavone@218: 					yield <- ylambda
pavone@218: 				}
pavone@218: 			}
pavone@218: 			sucexp <- syms fold: (successLambda expressions) with: :acc el {
pavone@218: 				lsym <- el orig
pavone@218: 				rsym <- el matchval
pavone@218: 				(quote: (lsym <- rsym)) | acc
pavone@218: 			}
pavone@218: 			successLambda <- successLambda expressions!: sucexp
pavone@256: 			withwhere addExpression: (quote: (ret <- if: matchres successLambda else: {
pavone@218: 				matchres
pavone@218: 			}))
pavone@256: 			withwhere addExpression: (quote: (tomatch memo: ret at: 0 withId: myid))
pavone@256: 			withwhere addExpression: (quote: ret)
pavone@256: 			
pavone@256: 			quote: :tomatch {
pavone@256: 				tomatch <- light: tomatch from: 0
pavone@256: 				tomatch getMemo: myid at: 0 else: withwhere
pavone@256: 			}
pavone@218: 		} else: {
pavone@218: 			print: "#error Error in main match expression of match:where:yield: " . (mcMain message) . "\n"
pavone@218: 		}
pavone@218: 	}
pavone@218: 
pavone@225: 	binaryOps:withHigherPrec <- macro: :oplist :higher {
pavone@225: 		quote: (match: Left . Pieces where: {
pavone@225: 			Left <- match: higher
pavone@225: 			Pieces <- zeroPlus: (match: hws . Op . Right where: {
pavone@230: 				Op <- matchOne: oplist
pavone@230: 				Right <- match: higher
pavone@225: 			} yield: {
pavone@225: 				#{
pavone@225: 					op <- Op
pavone@225: 					right <- Right
pavone@225: 				}
pavone@225: 			})
pavone@225: 		} yield: {
pavone@225: 			_processOpPieces: Left Pieces
pavone@225: 		})
pavone@225: 	}
pavone@225: 
pavone@226: 	opexpr <- binaryOps: ["&&" "||"] withHigherPrec: compare
pavone@226: 	compare <- binaryOps: ["<=" ">=" "<" ">" "=" "!="] withHigherPrec: maybecons
pavone@226: 	maybecons <- matchOne: [
pavone@226: 		consop
pavone@226: 		addsub
pavone@226: 	]
pavone@226: 	consop <- match: Left . hws . "|" . Right where: {
pavone@226: 		Left <- match: addsub
pavone@226: 		Right <- match: maybecons
pavone@226: 	} yield: {
pavone@246: 		ast binaryOp: "|" withArgs: Left Right
pavone@226: 	}
pavone@225: 	addsub <- binaryOps: ["+" "-" "."] withHigherPrec: muldiv
pavone@225: 	muldiv <- binaryOps: ["*" "/" "%"] withHigherPrec: primlitsym
pavone@225: 
pavone@209: 
pavone@209: 	_alpha <- charClass: "a-zA-Z"
pavone@209: 	alpha <- zeroPlus: _alpha
pavone@209: 	alphaNum <- zeroPlus: (charClass: "a-zA-Z0-9")
pavone@220: 
pavone@220: 	blockComment <- match: "/*" . (zeroPlus: (matchOne: [(charClass: "^*") "*" . (charClass: "^/")])) . "*/" yield: { false }
pavone@220: 
pavone@212: 	hws <- zeroPlus: (matchOne: [
pavone@212: 		(charClass: " \t")
pavone@220: 		blockComment
pavone@220: 	])
pavone@220: 
pavone@220: 	ws <- zeroPlus: (matchOne: [
pavone@220: 		(charClass: " \n\t\r")
pavone@220: 		"//" . (zeroPlus: (charClass: "^\n")) . "\n"
pavone@220: 		blockComment
pavone@212: 	])
pavone@212: 
pavone@220: 	escape <- matchOne: [
pavone@220: 		(match: "\\n" yield: {"\n"})
pavone@220: 		(match: "\\r" yield: {"\n"})
pavone@220: 		(match: "\\t" yield: {"\n"})
pavone@220: 		(match: "\\\\" yield: {"\\"})
pavone@220: 		(match: "\\\"" yield: {"\""})
pavone@220: 	]
pavone@220: 
pavone@220: 	string <- match: "\"" . Chars . "\"" where: {
pavone@220: 		Chars  <- zeroPlus: (matchOne: [
pavone@231: 			match: Reg where: { Reg <- charClass: "^\"\\" } yield: { Reg }
pavone@220: 			escape
pavone@220: 		])
pavone@220: 	} yield: {
pavone@231: 		if: (Chars length) = 0 {
pavone@231: 			Chars <- []
pavone@231: 		}
pavone@246: 		ast stringLit: (Chars join: "")
pavone@220: 	}
pavone@220: 
pavone@220: 	bdigit <- matchOne: [
pavone@220: 		(match: "0" yield: {0i64})
pavone@220: 		(match: "1" yield: {1i64})
pavone@220: 	]
pavone@220: 
pavone@213: 	digit <- matchOne: [
pavone@220: 		bdigit
pavone@220: 		(match: "2" yield: {2i64})
pavone@220: 		(match: "3" yield: {3i64})
pavone@220: 		(match: "4" yield: {4i64})
pavone@220: 		(match: "5" yield: {5i64})
pavone@220: 		(match: "6" yield: {6i64})
pavone@220: 		(match: "7" yield: {7i64})
pavone@220: 		(match: "8" yield: {8i64})
pavone@220: 		(match: "9" yield: {9i64})
pavone@213: 	]
pavone@208: 
pavone@220: 	hdigit <- matchOne: [
pavone@220: 		digit
pavone@220: 		(match: (charClass: "aA") yield: {10i64})
pavone@220: 		(match: (charClass: "bB") yield: {11i64})
pavone@220: 		(match: (charClass: "cC") yield: {12i64})
pavone@220: 		(match: (charClass: "dD") yield: {13i64})
pavone@220: 		(match: (charClass: "eE") yield: {14i64})
pavone@220: 		(match: (charClass: "fF") yield: {15i64})
pavone@220: 	]
pavone@220: 
pavone@220: 	binary <- match: "0b" . Digits . Suffix where: {
pavone@220: 		Digits <- onePlus: bdigit
pavone@220: 		Suffix <- matchOne: [
pavone@220: 			(charClass: "ui") . (matchOne: ["8" "16" "32" "64"])
pavone@220: 			""
pavone@220: 		]
pavone@218: 	} yield: {
pavone@218: 		num <- Digits fold: 0 with: :acc el {
pavone@220: 			acc * 2i64 + el
pavone@220: 		}
pavone@220: 		signed <- true
pavone@220: 		litbits <- 32
pavone@220: 		if: (Suffix length) > 0 {
pavone@220: 			if: (Suffix from: 0 withLength: 1) = "u" {
pavone@220: 				signed <- false
pavone@220: 			}
pavone@220: 			litbits <- (Suffix from: 1) int32
pavone@218: 		}
pavone@246: 		ast intLit: num withBits: litbits andBase: 2 signed?: signed
pavone@220: 	}
pavone@220: 
pavone@220: 	decimal <- match: Sign . Digits . Suffix where: {
pavone@220: 		Sign <- matchOne: ["-" ""]
pavone@220: 		Digits <- onePlus: digit
pavone@220: 		Suffix <- matchOne: [
pavone@220: 			(charClass: "ui") . (matchOne: ["8" "16" "32" "64"])
pavone@220: 			""
pavone@220: 		]
pavone@220: 	} yield: {
pavone@220: 		num <- Digits fold: 0 with: :acc el {
pavone@220: 			acc * 10i64 + el
pavone@220: 		}
pavone@220: 		if: Sign = "-" {
pavone@220: 			num <- 0i64 - num
pavone@220: 		}
pavone@220: 		signed <- true
pavone@220: 		litbits <- 32
pavone@220: 		if: (Suffix length) > 0 {
pavone@220: 			if: (Suffix from: 0 withLength: 1) = "u" {
pavone@220: 				signed <- false
pavone@220: 			}
pavone@220: 			litbits <- (Suffix from: 1) int32
pavone@220: 		}
pavone@246: 		ast intLit: num withBits: litbits andBase: 10 signed?: signed
pavone@220: 	}
pavone@220: 
pavone@222: 	hexlit <- match: "0x" . Digits . Suffix where: {
pavone@220: 		Digits <- onePlus: hdigit
pavone@220: 		Suffix <- matchOne: [
pavone@220: 			(charClass: "ui") . (matchOne: ["8" "16" "32" "64"])
pavone@220: 			""
pavone@220: 		]
pavone@220: 	} yield: {
pavone@220: 		num <- Digits fold: 0 with: :acc el {
pavone@220: 			acc * 16i64 + el
pavone@220: 		}
pavone@220: 		signed <- true
pavone@220: 		litbits <- 32
pavone@220: 		if: (Suffix length) > 0 {
pavone@220: 			if: (Suffix from: 0 withLength: 1) = "u" {
pavone@220: 				signed <- false
pavone@220: 			}
pavone@220: 			litbits <- (Suffix from: 1) int32
pavone@220: 		}
pavone@246: 		ast intLit: num withBits: litbits andBase: 16 signed?: signed
pavone@220: 	}
pavone@220: 
pavone@222: 	symexpr <- match: Name where: {
pavone@222: 		Name <- match: (onePlus: (charClass: "a-zA-Z_@!?")) . (zeroPlus: ((matchOne: [":" ""]) . (charClass: "a-zA-Z_@!?0-9")))
pavone@222: 	} yield: {
pavone@247: 		ast symbol: Name
pavone@222: 	}
pavone@222: 
pavone@222: 	namepart <- match: hws . Symbol . ":" where: {
pavone@222: 		Symbol <- match: symexpr
pavone@222: 	} yield: {
pavone@222: 		#{
pavone@222: 			isNamePart? <- { true }
pavone@222: 			val <- Symbol name
pavone@222: 		}
pavone@222: 	}
pavone@222: 
pavone@222: 	argpart <- matchOne: [
pavone@222: 		match: namepart
pavone@222: 		match: Arg where: {
pavone@222: 			Arg <- opexpr
pavone@222: 		} yield: {
pavone@222: 			#{
pavone@222: 				isNamePart? <- { false }
pavone@222: 				val <- Arg
pavone@222: 			}
pavone@222: 		}
pavone@222: 	]
pavone@222: 
pavone@222: 	funcall <- match: hws . Initial . Parts where: {
pavone@222: 		Initial <- match: namepart
pavone@244: 		Parts <- zeroPlus: argpart
pavone@222: 	} yield: {
pavone@244: 		if: (Parts length) = 0 {
pavone@244: 			Parts <- []
pavone@244: 		}
pavone@247: 		combined <- Initial | Parts foldr: #{
pavone@222: 			name <- ""
pavone@222: 			args <- []
pavone@222: 		} with: :acc el {
pavone@222: 			nextName <- acc name
pavone@222: 			nextArgs <- acc args
pavone@222: 			if: (el isNamePart?) {
pavone@222: 				nextName <- if: ((acc name) length) > 0 { (el val) . ":" . (acc name) } else: { el val }
pavone@222: 			} else: {
pavone@222: 				nextArgs <- (el val) | nextArgs
pavone@222: 			}
pavone@222: 			#{
pavone@222: 				name <- nextName
pavone@222: 				args <- nextArgs
pavone@222: 			}
pavone@222: 		}
pavone@247: 		ast funcall: (ast symbol: (combined name)) withArgs: (combined args) hasReceiver?: false
pavone@222: 	}
pavone@222: 
pavone@227: 	unarymeth <- match: Receiver . hws . Method where: {
pavone@227: 		Receiver <- match: opexpr
pavone@227: 		Method <- match: symexpr
pavone@227: 	} yield: {
pavone@247: 		ast funcall: Method withArgs: [Receiver] hasReceiver?: true
pavone@227: 	}
pavone@227: 
pavone@222: 	methcall <- match: Receiver . hws . Rest where: {
pavone@222: 		Receiver <- match: opexpr
pavone@227: 		Rest <- match: funcall
pavone@222: 	} yield: {
pavone@247: 		ast funcall: (Rest tocall) withArgs: Receiver | (Rest args) hasReceiver?: true
pavone@222: 	}
pavone@223: 	_processOpPieces <- :Left Pieces {
pavone@223: 		if: (Pieces length) > 0 {
pavone@223: 			Pieces fold: Left with: :acc piece {
pavone@247: 				ast binaryOp: (piece op) withArgs: acc (piece right)
pavone@223: 			}
pavone@223: 		} else: {
pavone@223: 			Left
pavone@223: 		}
pavone@223: 	}
pavone@223: 
pavone@222: 	expr <- match: (hws . Expr . ws) where: {
pavone@222: 		Expr <- matchOne: [
pavone@222: 			funcall
pavone@222: 			methcall
pavone@227: 			unarymeth
pavone@230: 			assignment
pavone@227: 			opexpr
pavone@227: 		]
pavone@227: 	} yield: {
pavone@227: 		Expr
pavone@227: 	}
pavone@227: 
pavone@227: 	lexpr <- match: (hws . Expr . ws) where: {
pavone@227: 		Expr <- matchOne: [
pavone@227: 			funcall
pavone@227: 			methcall
pavone@222: 			opexpr
pavone@222: 		]
pavone@222: 	} yield: {
pavone@222: 		Expr
pavone@222: 	}
pavone@222: 
pavone@244: 	opsym <- match: Name where: {
pavone@244: 		Name <- matchOne: ["&&" "||" "<=" ">=" "<" ">" "=" "!=" "=" "-" "." "*" "/" "%" "|"]
pavone@244: 	} yield: {
pavone@256: 		ast symbol: Name
pavone@244: 	}
pavone@244: 
pavone@222: 	assignment <- match: ws . Symbol . hws . "<-" . Expr where: {
pavone@244: 		Symbol <- matchOne: [
pavone@244: 			symexpr
pavone@244: 			opsym
pavone@244: 		]
pavone@222: 		Expr <- match: expr
pavone@222: 	} yield: {
pavone@247: 		ast assign: Expr to: Symbol
pavone@222: 	}
pavone@222: 
pavone@222: 	object <- match: "#{" . ws . Messages . "}" where: {
pavone@244: 		Messages <- zeroPlus: (match: ws . El where: {
pavone@244: 			El <- matchOne: [
pavone@244: 				assignment
pavone@244: 				funcall
pavone@244: 			]
pavone@244: 		} yield: { El })
pavone@222: 	} yield: {
pavone@244: 		if: (Messages length) = 0 {
pavone@244: 			Messages <- []
pavone@244: 		}
pavone@247: 		ast object: Messages
pavone@222: 	}
pavone@222: 
pavone@227: 	listlit <- match: "[" . ws . Els . "]" where: {
pavone@227: 		Els <- zeroPlus: lexpr
pavone@227: 	} yield: {
pavone@227: 		//Handle limitation of zeroPlus macro
pavone@227: 		if: (Els length) = 0 {
pavone@227: 			Els <- []
pavone@227: 		}
pavone@247: 		ast seqLit: Els array?: false
pavone@227: 	}
pavone@227: 
pavone@228: 	arraylit <- match: "#[" . ws . Els . "]" where: {
pavone@228: 		Els <- zeroPlus: lexpr
pavone@228: 	} yield: {
pavone@228: 		//Handle limitation of zeroPlus macro
pavone@228: 		if: (Els length) = 0 {
pavone@228: 			Els <- []
pavone@228: 		}
pavone@247: 		ast seqLit: Els array?: true
pavone@228: 	}
pavone@228: 
pavone@230: 	argname <- match: hws . Pre . Initial . Rest where: {
pavone@230: 		Pre <- matchOne: [":" ""]
pavone@230: 		Initial <- onePlus: (charClass: "a-zA-Z_!?@")
pavone@230: 		Rest <- zeroPlus: (charClass: "a-zA-Z_!?@0-9")
pavone@230: 	} yield: {
pavone@230: 		Pre . Initial . Rest
pavone@230: 	}
pavone@230: 
pavone@230: 	lambda <- match: hws . Arglist . hws . "{" . ws . Exprs . "}" where: {
pavone@230: 		Arglist <- matchOne: [
pavone@230: 			match: ":" . First . Rest where: {
pavone@230: 				First <- match: symexpr
pavone@230: 				Rest <- zeroPlus: argname
pavone@230: 			} yield: {
pavone@230: 				if: (Rest length) = 0 {
pavone@230: 					Rest <- []
pavone@230: 				}
pavone@230: 				":" . (First name) | Rest
pavone@230: 			}
pavone@230: 			match: "" yield: { [] }
pavone@230: 		]
pavone@230: 		Exprs <- zeroPlus: expr
pavone@230: 	} yield: {
pavone@230: 		if: (Exprs length) = 0 {
pavone@230: 			Exprs <- []
pavone@230: 		}
pavone@247: 		ast lambda: Exprs withArgs: Arglist
pavone@230: 	}
pavone@230: 
pavone@231: 	parenexp <- match: "(" . ws . Expr . ws . ")" where: {
pavone@231: 		Expr <- match: expr
pavone@231: 	} yield: {
pavone@231: 		Expr
pavone@231: 	}
pavone@231: 
pavone@222: 	primlitsym <- match: hws . Lit where: {
pavone@222: 		Lit <- matchOne: [
pavone@222: 			hexlit
pavone@222: 			binary
pavone@222: 			decimal
pavone@222: 			symexpr
pavone@230: 			lambda
pavone@222: 			object
pavone@227: 			listlit
pavone@228: 			arraylit
pavone@231: 			string
pavone@231: 			parenexp
pavone@222: 		]
pavone@222: 	} yield: {
pavone@222: 		Lit
pavone@222: 	}
pavone@222: 
pavone@231: 	top <- matchOne: [
pavone@231: 		object
pavone@231: 		lambda
pavone@231: 	]
pavone@231: 
pavone@246: 	testmatchintlit <- :tomatch matchfun {
pavone@246: 		res <- matchfun: tomatch
pavone@242: 		if: res {
pavone@220: 			y <- res yield
pavone@246: 			print: tomatch . " matched with litval " . (y val) . ", bits " . (y bits) . " and singned? " . (y signed?) . "\n"
pavone@220: 		} else: {
pavone@246: 			print: tomatch . " did not match\n"
pavone@218: 		}
pavone@218: 	}
pavone@218: 
pavone@231: 	main <- :args {
pavone@209: 		cmatch <- alpha: "czx0123"
pavone@208: 		zeromatch <- alpha: "01234"
pavone@242: 		if: cmatch {
pavone@209: 			print: "czx0123 matched with length " . (cmatch matchlen) . "\n"
pavone@208: 		} else: {
pavone@209: 			print: "czx0123 didn't match\n"
pavone@208: 		}
pavone@242: 		if: zeromatch {
pavone@208: 			print: "0123 matched with length " . (zeromatch matchlen) . "\n"
pavone@208: 		} else: {
pavone@208: 			print: "0123 didn't match\n"
pavone@208: 		}
pavone@209: 		zeromatchanum <- alphaNum: "01234"
pavone@242: 		if: zeromatchanum {
pavone@209: 			print: "01234 matched with length " . (zeromatchanum matchlen) . "\n"
pavone@209: 		} else: {
pavone@209: 			print: "01234 didn't match\n"
pavone@209: 		}
pavone@212: 		stuff <- " \t/* blah blah blah * blah */ foo"
pavone@212: 		hwsmatch <- hws: stuff
pavone@242: 		if: hwsmatch {
pavone@212: 			print: "'" . (stuff from: (hwsmatch matchlen)) . "' found after hws\n"
pavone@212: 		} else: {
pavone@212: 			print: stuff . " did not match hws rule\n"
pavone@212: 		}
pavone@213: 		tmatch <- digit: "3"
pavone@242: 		if: tmatch {
pavone@213: 			print: "3 matched with yield " . (tmatch yield) . ", yield + 1 = " . ((tmatch yield) + 1) . "\n"
pavone@213: 		} else: {
pavone@213: 			print: "3 did not match\n"
pavone@213: 		}
pavone@218: 
pavone@220: 		testmatchintlit: "345" :s {decimal: s}
pavone@220: 		testmatchintlit: "-567" :s {decimal: s}
pavone@220: 		testmatchintlit: "123u16" :s {decimal: s}
pavone@222: 		testmatchintlit: "0x20" :s {hexlit: s}
pavone@222: 		testmatchintlit: "0x42u64" :s {hexlit: s}
pavone@220: 		testmatchintlit: "0b10101" :s {binary: s}
pavone@230: 		code <- "#{ foo <- 123 > 0x42 && 42 < 104\n bar <- 0xABC + 0b1010101\n baz <- 0b1010 * 5\n qux <- fo: 38 shizzle: bam\n quine <- 123 | [4 5 6 fiddle sticks]\n quizzle <- #[receiver meth: arg]\n blah <- :arg arg2 :arg3 { arg + arg2 + arg3 }}"
pavone@231: 		if: (args length) > 1 {
pavone@231: 			file <- os open: (args get: 1) (os O_RDONLY)
pavone@236: 			code <- ""
pavone@236: 			chunksize <- 1024
pavone@236: 			readsize <- chunksize
pavone@236: 			while: { readsize = chunksize} do: {
pavone@236: 				seg <- os read: file chunksize
pavone@236: 				code <- code . seg
pavone@236: 				readsize <- seg byte_length
pavone@236: 			}
pavone@231: 		}
pavone@231: 		codem <- top: code
pavone@242: 		if: codem {
pavone@222: 			print: code . "\nmatched with yield:\n" . (codem yield) . "\n"
pavone@222: 		} else: {
pavone@222: 			print: code . "\ndid not match\n"
pavone@222: 		}
pavone@208: 	}
pavone@208: }
pavone@239: }