changeset 239:6aab8a5a2be9

Don't expose internal helper functions in parser module
author Mike Pavone <pavone@retrodev.com>
date Sun, 05 Jan 2014 19:28:09 -0800
parents 3bfc00e4f5e5
children dc5f487247ee
files modules/parser.tp
diffstat 1 files changed, 252 insertions(+), 249 deletions(-) [+]
line wrap: on
line diff
--- a/modules/parser.tp	Sun Jan 05 19:27:41 2014 -0800
+++ b/modules/parser.tp	Sun Jan 05 19:28:09 2014 -0800
@@ -1,29 +1,262 @@
-#{
-	_applyMatch <- :fun tomatch {
+{
+_applyMatch <- :fun tomatch {
 		fun: tomatch
 	}
-	_matchString <- :str tomatch {
-		if: (tomatch isString?) {
-			if: (tomatch length) < (str length) {
+_matchString <- :str tomatch {
+	if: (tomatch isString?) {
+		if: (tomatch length) < (str length) {
+			#{
+				matched? <- { false }
+			}
+		} else: {
+			if: (tomatch length) > (str length) {
+				tomatch <- tomatch from: 0 withLength: (str length)
+			}
+			if: str = tomatch {
+				#{
+					matched? <- { true }
+					matchlen <- { str length }
+					basicYield? <- { true }
+					yield <- { str }
+				}
+			} else: {
 				#{
 					matched? <- { false }
 				}
-			} else: {
-				if: (tomatch length) > (str length) {
-					tomatch <- tomatch from: 0 withLength: (str length)
+			}
+		}
+	} else: {
+		#{
+			matched? <- { false }
+		}
+	}
+}
+_makeMatchCall <- :matchexpr {
+	if: (matchexpr nodeType) = "lambda" {
+		#{
+			valid? <- { true }
+			matchcall <- quote: (_applyMatch: matchexpr tomatch)
+		}
+	} else: {
+		if: (matchexpr nodeType) = "symbol" {
+			#{
+				valid? <- { true }
+				matchcall <- quote: (matchexpr: tomatch)
+			}
+		} else: {
+			if: (matchexpr nodeType) = "strlit" {
+				#{
+					valid? <- { true }
+					matchcall <- quote: (_matchString: matchexpr tomatch)
 				}
-				if: str = tomatch {
-					#{
-						matched? <- { true }
-						matchlen <- { str length }
-						basicYield? <- { true }
-						yield <- { str }
+			} else: {
+				if: (matchexpr nodeType) = "op" {
+					if: (matchexpr opName) = "." {
+						left <- (_makeMatchCall: (matchexpr left)) matchcall
+						right <- (_makeMatchCall: (matchexpr right)) matchcall
+						#{
+							valid? <- { true }
+							matchcall <- quote: (_applyMatch: :tomatch {
+								lm <- left
+								if: (lm matched?) {
+									orig <- tomatch
+									tomatch <- tomatch from: (lm matchlen)
+									rm <- right
+									if: (rm matched?) {
+										total <- (rm matchlen) + (lm matchlen)
+										#{
+											matched? <- { true }
+											matchlen <- { total }
+											basicYield? <- { true }
+											yield <- { orig from: 0 withLength: total }
+										}
+									} else: {
+										rm
+									}
+								} else: {
+									lm
+								}
+							} tomatch)
+						}
+					} else: {
+						#{
+							valid? <- { false }
+							message <- "Unsupported operator " . (matchexpr opName)
+						}
 					}
 				} else: {
 					#{
-						matched? <- { false }
+						valid? <- { false }
+						message <- "Unsupported AST node type " . (matchexpr nodeType)
+					}
+				}
+			}
+		}
+	}
+}
+_nPlus <- :matchexpr min {
+	funexpr <- false
+	valid <- false
+	mc <- _makeMatchCall: matchexpr
+	if: (mc valid?) {
+		mcall <- mc matchcall
+		quote: :tomatch {
+			cur <- 0
+			count <- 0
+			n <- tomatch byte_length
+			orig <- tomatch
+			_match <- true
+			allBasic? <- true
+			yieldvals <- []
+			while: { _match && cur < n } do: {
+				res <- mcall
+				_match <- res matched?
+				if: _match {
+					count <- count + 1
+					//TODO: Use some kind of lightweight substring wrapper here
+					tomatch <- tomatch from: (res matchlen)
+					if: allBasic? {
+						ifnot: (res basicYield?) {
+							allBasic? <- false
+							if: cur > 0 {
+								yieldvals <- (orig from: 0 withLength: cur) | yieldvals
+							}
+							yieldvals <- (res yield) | yieldvals
+						}
+					} else: {
+						yieldvals <- (res yield) | yieldvals
+					}
+					allBasic? <- allBasic? && (res basicYield?)
+					cur <- cur + (res matchlen)
+				}
+			}
+			if: count >= min {
+				if: allBasic? {
+					#{
+						matched? <- { true }
+						matchlen <- { cur }
+						basicYield? <- { true }
+						yield <- { orig from: 0 withLength: cur }
+					}
+				} else: {
+					yieldvals <- yieldvals reverse
+					#{
+						matched? <- { true }
+						matchlen <- { cur }
+						basicYield? <- { false }
+						yield <- { yieldvals }
 					}
 				}
+			} else: {
+				#{
+					matched? <- { false }
+				}
+			}
+		}
+	} else: {
+		print: "#error Invalid nPlus macro call: " . (mc message) . "\n"
+	}
+}
+_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 <- ""
+			//skip control characters for now
+			cur <- 32
+			while: { cur < 256 } do: {
+				notfound <- true
+				idx <- 0
+				len <- (old length)
+				while: { notfound && idx < len } do: {
+					if: cur = (old byte: idx) {
+						notfound <- false
+					} else: {
+						idx <- idx + 1
+					}
+				}
+				if: notfound {
+					out <- out . (cur asStringChar)
+				}
+				cur <- cur + 1
+			}
+		}
+		out
+	} else: {
+		""
+	}
+}
+_charClass <- :chars {
+	chars <- _expandClass: chars
+	charmap <- ""
+	char <- 0
+	while: { char < 256 } do: {
+		mchar <- 0
+		found <- false
+		while: { mchar < (chars byte_length)} do: {
+			if: (chars byte: mchar) = char {
+				found <- true
+				mchar <- chars byte_length
+			}
+			mchar <- mchar + 1
+		}
+		charmap <- charmap . (if: found { "t" } else: { "f" })
+		char <- char + 1
+	}
+	t <- "t" byte: 0
+	quote: :tomatch {
+		if: (tomatch isString?) {
+			if: (charmap byte: (tomatch byte: 0)) = t {
+				#{
+					matched? <- { true }
+					matchlen <- { 1 }
+					basicYield? <- { true }
+					yield <- { tomatch from: 0 withLength: 1 }
+				}
+			} else: {
+				#{
+					matched? <- { false }
+				}
 			}
 		} else: {
 			#{
@@ -31,6 +264,8 @@
 			}
 		}
 	}
+}
+#{
 	ifmatch:else <- :matchres :elseblock {
 		if: (matchres matched?) {
 			matchres
@@ -38,247 +273,14 @@
 			elseblock:
 		}
 	}
-	_makeMatchCall <- :matchexpr {
-		if: (matchexpr nodeType) = "lambda" {
-			#{
-				valid? <- { true }
-				matchcall <- quote: (_applyMatch: matchexpr tomatch)
-			}
-		} else: {
-			if: (matchexpr nodeType) = "symbol" {
-				#{
-					valid? <- { true }
-					matchcall <- quote: (matchexpr: tomatch)
-				}
-			} else: {
-				if: (matchexpr nodeType) = "strlit" {
-					#{
-						valid? <- { true }
-						matchcall <- quote: (_matchString: matchexpr tomatch)
-					}
-				} else: {
-					if: (matchexpr nodeType) = "op" {
-						if: (matchexpr opName) = "." {
-							left <- (_makeMatchCall: (matchexpr left)) matchcall
-							right <- (_makeMatchCall: (matchexpr right)) matchcall
-							#{
-								valid? <- { true }
-								matchcall <- quote: (_applyMatch: :tomatch {
-									lm <- left
-									if: (lm matched?) {
-										orig <- tomatch
-										tomatch <- tomatch from: (lm matchlen)
-										rm <- right
-										if: (rm matched?) {
-											total <- (rm matchlen) + (lm matchlen)
-											#{
-												matched? <- { true }
-												matchlen <- { total }
-												basicYield? <- { true }
-												yield <- { orig from: 0 withLength: total }
-											}
-										} else: {
-											rm
-										}
-									} else: {
-										lm
-									}
-								} tomatch)
-							}
-						} else: {
-							#{
-								valid? <- { false }
-								message <- "Unsupported operator " . (matchexpr opName)
-							}
-						}
-					} else: {
-						#{
-							valid? <- { false }
-							message <- "Unsupported AST node type " . (matchexpr nodeType)
-						}
-					}
-				}
-			}
-		}
-	}
-	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 <- ""
-				//skip control characters for now
-				cur <- 32
-				while: { cur < 256 } do: {
-					notfound <- true
-					idx <- 0
-					len <- (old length)
-					while: { notfound && idx < len } do: {
-						if: cur = (old byte: idx) {
-							notfound <- false
-						} else: {
-							idx <- idx + 1
-						}
-					}
-					if: notfound {
-						out <- out . (cur asStringChar)
-					}
-					cur <- cur + 1
-				}
-			}
-			out
-		} else: {
-			""
-		}
-	}
 	charClass <- macro: :rawchars {
 		eval: rawchars :chars {
-			orig <- chars
-			chars <- expandClass: chars
-			charmap <- ""
-			char <- 0
-			while: { char < 256 } do: {
-				mchar <- 0
-				found <- false
-				while: { mchar < (chars byte_length)} do: {
-					if: (chars byte: mchar) = char {
-						found <- true
-						mchar <- chars byte_length
-					}
-					mchar <- mchar + 1
-				}
-				charmap <- charmap . (if: found { "t" } else: { "f" })
-				char <- char + 1
-			}
-			t <- "t" byte: 0
-			quote: :tomatch {
-				if: (tomatch isString?) {
-					if: (charmap byte: (tomatch byte: 0)) = t {
-						#{
-							matched? <- { true }
-							matchlen <- { 1 }
-							basicYield? <- { true }
-							yield <- { tomatch from: 0 withLength: 1 }
-						}
-					} else: {
-						#{
-							matched? <- { false }
-						}
-					}
-				} else: {
-					#{
-						matched? <- { false }
-					}
-				}
-			}
+			_charClass: chars
 		} else: {
 			print: "#error Argument to charClass macro must be a compile-time constant\n"
 		}
 	}
 
-	_nPlus <- :matchexpr min {
-		funexpr <- false
-		valid <- false
-		mc <- _makeMatchCall: matchexpr
-		if: (mc valid?) {
-			mcall <- mc matchcall
-			quote: :tomatch {
-				cur <- 0
-				count <- 0
-				n <- tomatch byte_length
-				orig <- tomatch
-				_match <- true
-				allBasic? <- true
-				yieldvals <- []
-				while: { _match && cur < n } do: {
-					res <- mcall
-					_match <- res matched?
-					if: _match {
-						count <- count + 1
-						//TODO: Use some kind of lightweight substring wrapper here
-						tomatch <- tomatch from: (res matchlen)
-						if: allBasic? {
-							ifnot: (res basicYield?) {
-								allBasic? <- false
-								if: cur > 0 {
-									yieldvals <- (orig from: 0 withLength: cur) | yieldvals
-								}
-								yieldvals <- (res yield) | yieldvals
-							}
-						} else: {
-							yieldvals <- (res yield) | yieldvals
-						}
-						allBasic? <- allBasic? && (res basicYield?)
-						cur <- cur + (res matchlen)
-					}
-				}
-				if: count >= min {
-					if: allBasic? {
-						#{
-							matched? <- { true }
-							matchlen <- { cur }
-							basicYield? <- { true }
-							yield <- { orig from: 0 withLength: cur }
-						}
-					} else: {
-						yieldvals <- yieldvals reverse
-						#{
-							matched? <- { true }
-							matchlen <- { cur }
-							basicYield? <- { false }
-							yield <- { yieldvals }
-						}
-					}
-				} else: {
-					#{
-						matched? <- { false }
-					}
-				}
-			}
-		} else: {
-			print: "#error Invalid nPlus macro call: " . (mc message) . "\n"
-		}
-	}
-
 	zeroPlus <- macro: :matchexpr {
 		_nPlus: matchexpr 0
 	}
@@ -993,3 +995,4 @@
 		}
 	}
 }
+}