summaryrefslogtreecommitdiff
path: root/system/base/1.7.5/src/scanner
diff options
context:
space:
mode:
Diffstat (limited to 'system/base/1.7.5/src/scanner')
-rw-r--r--system/base/1.7.5/src/scanner325
1 files changed, 325 insertions, 0 deletions
diff --git a/system/base/1.7.5/src/scanner b/system/base/1.7.5/src/scanner
new file mode 100644
index 0000000..35a632c
--- /dev/null
+++ b/system/base/1.7.5/src/scanner
@@ -0,0 +1,325 @@
+(* ------------------- VERSION 4 14.05.86 ------------------- *)
+PACKET scanner DEFINES (* Autor: J.Liedtke *)
+
+ scan ,
+ continue scan ,
+ next symbol :
+
+
+LET tag = 1 ,
+ bold = 2 ,
+ number = 3 ,
+ text = 4 ,
+ operator= 5 ,
+ delimiter = 6 ,
+ end of file = 7 ,
+ within comment = 8 ,
+ within text = 9 ;
+
+LET digit 0 = 48 ,
+ digit 9 = 57 ,
+ upper case a = 65 ,
+ upper case z = 90 ,
+ lower case a = 97 ,
+ lower case z = 122;
+
+
+TEXT VAR line := "" ,
+ char := "" ,
+ chars:= "" ;
+
+INT VAR position := 0 ,
+ comment depth ;
+BOOL VAR continue text ;
+
+
+PROC scan (TEXT CONST scan text) :
+
+ comment depth := 0 ;
+ continue text := FALSE ;
+ continue scan (scan text)
+
+ENDPROC scan ;
+
+PROC continue scan (TEXT CONST scan text) :
+
+ line := scan text ;
+ position := 0 ;
+ nextchar
+
+ENDPROC continue scan ;
+
+PROC next symbol (TEXT VAR symbol) :
+
+ INT VAR type ;
+ next symbol (symbol, type)
+
+ENDPROC next symbol ;
+
+PROC next symbol (TEXT VAR symbol, INT VAR type) :
+
+ skip blanks ;
+ IF is begin comment THEN process comment
+ ELIF comment depth > 0 THEN comment depth DECR 1 ;
+ process comment
+ ELIF is quote OR continue text THEN process text
+ ELIF is lower case letter THEN process tag
+ ELIF is upper case letter THEN process bold
+ ELIF is digit THEN process number
+ ELIF is delimiter THEN process delimiter
+ ELIF is niltext THEN eof
+ ELSE process operator
+ FI .
+
+
+process comment :
+ read comment ;
+ IF comment depth = 0
+ THEN next symbol (symbol, type)
+ ELSE type := within comment ;
+ symbol := ""
+ FI .
+
+process tag :
+ type := tag ;
+ assemble chars (lower case a, lower case z) ;
+ symbol := chars ;
+ REP
+ skip blanks ;
+ IF is lower case letter
+ THEN assemble chars (lower case a, lower case z)
+ ELIF is digit
+ THEN assemble chars (digit 0, digit 9)
+ ELSE LEAVE process tag
+ FI ;
+ symbol CAT chars
+ PER ;
+ nextchar .
+
+process bold :
+ type := bold ;
+ assemble chars (upper case a, upper case z) ;
+ symbol := chars .
+
+process number :
+ type := number ;
+ assemble chars (digit 0, digit 9) ;
+ symbol := chars ;
+ IF char = "." AND ahead char is digit
+ THEN process fraction ;
+ IF char = "e"
+ THEN process exponent
+ FI
+ FI .
+
+ahead char is digit :
+ digit 0 <= code (ahead char) AND code (ahead char) <= digit 9 .
+
+process fraction :
+ symbol CAT char ;
+ nextchar ;
+ assemble chars (digit 0, digit 9) ;
+ symbol CAT chars .
+
+process exponent :
+ symbol CAT char ;
+ nextchar ;
+ IF char = "+" OR char = "-"
+ THEN symbol CAT char ;
+ nextchar
+ FI ;
+ assemble chars (digit 0, digit 9) ;
+ symbol CAT chars .
+
+process text :
+ type := text ;
+ symbol := "" ;
+ IF continue text
+ THEN continue text := FALSE
+ ELSE next char
+ FI ;
+ WHILE not end of text REP
+ assemble chars (35, 254) ;
+ symbol CAT chars ;
+ IF NOT is quote
+ THEN symbol CAT char ;
+ nextchar
+ FI
+ ENDREP .
+
+not end of text :
+ IF is niltext
+ THEN continue text := TRUE ; type := within text ; FALSE
+ ELIF is quote
+ THEN end of text or exception
+ ELSE TRUE
+ FI .
+
+end of text or exception :
+ next char ;
+ IF is quote
+ THEN get quote ; TRUE
+ ELIF is digit
+ THEN get special char ; TRUE
+ ELSE FALSE
+ FI .
+
+get quote :
+ symbol CAT char ;
+ nextchar .
+
+get special char :
+ assemble chars (digit 0, digit 9) ;
+ symbol CAT code (int (chars) ) ;
+ nextchar .
+
+process delimiter :
+ type := delimiter ;
+ symbol := char ;
+ nextchar .
+
+process operator :
+ type := operator ;
+ symbol := char ;
+ nextchar ;
+ IF symbol = ":"
+ THEN IF char = "=" OR char = ":"
+ THEN symbol := ":=" ;
+ nextchar
+ ELSE type := delimiter
+ FI
+ ELIF is relational double char
+ THEN symbol CAT char ;
+ nextchar
+ ELIF symbol = "*" AND char = "*"
+ THEN symbol := "**" ;
+ next char
+ FI .
+
+eof :
+ type := end of file ;
+ symbol := "" .
+
+is lower case letter :
+ lower case a <= code (char) AND code (char) <= lower case z .
+
+is upper case letter :
+ upper case a <= code (char) AND code (char) <= upper case z .
+
+is digit :
+ digit 0 <= code (char) AND code (char) <= digit 9 .
+
+is delimiter : pos ( "()[].,;" , char ) > 0 .
+
+is relational double char :
+ TEXT VAR double := symbol + char ;
+ double = "<>" OR double = "<=" OR double = ">=" .
+
+is quote : char = """" .
+
+is niltext : char = "" .
+
+is begin comment : char = "{" OR char = "(" AND ahead char = "*" .
+
+ENDPROC next symbol ;
+
+PROC next char :
+
+ position INCR 1 ;
+ char := line SUB position
+
+ENDPROC next char ;
+
+PROC skip blanks :
+
+ position := pos (line, ""33"", ""254"", position) ;
+ IF position = 0
+ THEN position := LENGTH line + 1
+ FI ;
+ char := line SUB position .
+
+ENDPROC skip blanks ;
+
+TEXT PROC ahead char :
+
+ line SUB position+1
+
+ENDPROC ahead char ;
+
+PROC assemble chars (INT CONST low, high) :
+
+ INT CONST begin := position ;
+ position behind valid text ;
+ chars := subtext (line, begin, position-1) ;
+ char := line SUB position .
+
+position behind valid text :
+ position := pos (line, ""32"", code (low-1), begin) ;
+ IF position = 0
+ THEN position := LENGTH line + 1
+ FI ;
+ INT CONST higher pos := pos (line, code (high+1), ""254"", begin) ;
+ IF higher pos <> 0 AND higher pos < position
+ THEN position := higher pos
+ FI .
+
+ENDPROC assemble chars ;
+
+
+PROC read comment :
+
+ TEXT VAR last char ;
+ comment depth INCR 1 ;
+ REP
+ last char := char ;
+ nextchar ;
+ IF is begin comment
+ THEN read comment
+ FI ;
+ IF char = ""
+ THEN LEAVE read comment
+ FI
+ UNTIL is end comment PER ;
+ comment depth DECR 1 ;
+ next char ;
+ skip blanks .
+
+is end comment :
+ char = "}" OR char = ")" AND last char = "*" .
+
+is begin comment :
+ char = "{" OR char = "(" AND ahead char = "*" .
+
+ENDPROC read comment ;
+
+
+PROC scan (FILE VAR f) :
+
+ getline (f, line) ;
+ scan (line)
+
+ENDPROC scan ;
+
+PROC next symbol (FILE VAR f, TEXT VAR symbol) :
+
+ INT VAR type ;
+ next symbol (f, symbol, type)
+
+ENDPROC next symbol ;
+
+TEXT VAR scanned ;
+
+PROC next symbol (FILE VAR f, TEXT VAR symbol, INT VAR type) :
+
+ next symbol (symbol, type) ;
+ WHILE type >= 7 AND NOT eof (f) REP
+ getline (f, line) ;
+ continue scan (line) ;
+ next symbol (scanned, type) ;
+ symbol CAT scanned
+ PER .
+
+ENDPROC next symbol ;
+
+ENDPACKET scanner ;
+