view modules/parser.tp @ 209:4b3b57f39f10

Implement zeroPlus macro
author Michael Pavone <pavone@retrodev.com>
date Wed, 27 Nov 2013 23:36:24 -0800
parents a1b4a2bc8d72
children 32080f96c3a0
line wrap: on
line source

#{
	_applyMatch <- :fun tomatch {
		fun: tomatch
	}
	expandClass <- :chars {
		if: (chars length) > 0 {
			pos <- 0
			inverted <- false
			if: (chars byte: 0) = ("^" byte: 0) {
				pos <- 1
				inverted <- true
			}
			state_begin <- 0
			state_normal <- 1
			state_rangeend <- 2
			state <- state_begin
			out <- ""
			while: { pos < (chars byte_length)} do: {
				if: state = state_begin {
					out <- out . (chars from: pos withLength: 1)
					state <- state_normal
				} else: {
					if: state = state_normal {
						if: (chars byte: pos) = ("-" byte: 0) {
							state <- state_rangeend
						} else: {
							out <- out . (chars from: pos withLength: 1)
						}
					} else: {
						rangestart <- out byte: ((out byte_length) - 1)
						rangeend <- chars byte: pos
						if: rangeend < rangestart {
							tmp <- rangeend
							rangeend <- rangestart
							rangestart <- tmp
						}
						out <- out from: 0 withLength: ((out length) - 1)
						while: { rangestart <= rangeend } do: {
							out <- out . (rangestart asStringChar)
							rangestart <- rangestart + 1
						}
						state <- state_begin
					}
				}
				pos <- pos + 1
			}
			if: inverted {
				old <- out
				out <- ""
				cur <- 0
				while: { cur < 256 } do: {
					out <- out . (cur asStringChar)
					cur <- cur + 1
				}
			}
			out
		} else: {
			""
		}
	}
	charClass <- macro: :rawchars {
		eval: rawchars :chars {
			chars <- expandClass: chars
			//TODO: Use a more sophisticated approach for large classes
			quote: :tomatch {
				if: (tomatch isString?) {
					check <- 0

					nomatch <- true
					while: { nomatch && check < (chars byte_length) } do: {
						if: (tomatch byte: 0) = (chars byte: check) {
							nomatch <- false
						}
						check <- check + 1
					}
					if: nomatch {
						#{
							matched? <- { false }
						}
					} else: {
						#{
							matched? <- { true }
							matchlen <- { 1 }
						}
					}
				} else: {
					#{
						matched? <- { false }
					}
				}
			}
		} else: {
			print: "uh oh"
		}
	}

	zeroPlus <- macro: :matchexpr {
		funexpr <- false
		valid <- false
		matchcall <- if: (matchexpr nodeType) = "lambda" {
			valid <- true
			quote: (_applyMatch: matchexpr tomatch)
		} else: {
			if: (matchexpr nodeType) = "symbol" {
				valid <- true
				quote: (matchexpr: tomatch)
			}
		}
		if: valid {
			quote: :tomatch {
				cur <- 0
				n <- tomatch byte_length
				orig <- tomatch
				match <- true
				while: { match && cur < n } do: {
					res <- matchcall
					match <- res matched?
					if: match {
						//TODO: Use some kind of lightweight substring wrapper here
						tomatch <- tomatch from: (res matchlen)
						cur <- cur + (res matchlen)
					}
				}
				if: cur > 0 {
					#{
						matched? <- { true }
						matchlen <- { cur }
					}
				} else: {
					#{
						matched? <- { false }
					}
				}
			}
		} else: {
			print: "#error Invalid zeroPlus macro call\n"
		}
	}


	_alpha <- charClass: "a-zA-Z"
	alpha <- zeroPlus: _alpha
	alphaNum <- zeroPlus: (charClass: "a-zA-Z0-9")

	main <- {
		cmatch <- alpha: "czx0123"
		zeromatch <- alpha: "01234"
		if: (cmatch matched?) {
			print: "czx0123 matched with length " . (cmatch matchlen) . "\n"
		} else: {
			print: "czx0123 didn't match\n"
		}
		if: (zeromatch matched?) {
			print: "0123 matched with length " . (zeromatch matchlen) . "\n"
		} else: {
			print: "0123 didn't match\n"
		}
		zeromatchanum <- alphaNum: "01234"
		if: (zeromatchanum matched?) {
			print: "01234 matched with length " . (zeromatchanum matchlen) . "\n"
		} else: {
			print: "01234 didn't match\n"
		}
	}
}