Add the tiger source code bundle from the book site
Signed-off-by: jmug <u.g.a.mariano@gmail.com>
This commit is contained in:
parent
915660c8a7
commit
33d8bac511
87 changed files with 3252 additions and 0 deletions
53
tiger/chap3/errormsg.sml
Normal file
53
tiger/chap3/errormsg.sml
Normal file
|
|
@ -0,0 +1,53 @@
|
|||
signature ERRORMSG =
|
||||
sig
|
||||
val anyErrors : bool ref
|
||||
val fileName : string ref
|
||||
val lineNum : int ref
|
||||
val linePos : int list ref
|
||||
val sourceStream : TextIO.instream ref
|
||||
val error : int -> string -> unit
|
||||
exception Error
|
||||
val impossible : string -> 'a (* raises Error *)
|
||||
val reset : unit -> unit
|
||||
end
|
||||
|
||||
structure ErrorMsg : ERRORMSG =
|
||||
struct
|
||||
|
||||
val anyErrors = ref false
|
||||
val fileName = ref ""
|
||||
val lineNum = ref 1
|
||||
val linePos = ref [1]
|
||||
val sourceStream = ref TextIO.stdIn
|
||||
|
||||
fun reset() = (anyErrors:=false;
|
||||
fileName:="";
|
||||
lineNum:=1;
|
||||
linePos:=[1];
|
||||
sourceStream:=TextIO.stdIn)
|
||||
|
||||
exception Error
|
||||
|
||||
fun error pos (msg:string) =
|
||||
let fun look(a::rest,n) =
|
||||
if a<pos then app print [":",
|
||||
Int.toString n,
|
||||
".",
|
||||
Int.toString (pos-a)]
|
||||
else look(rest,n-1)
|
||||
| look _ = print "0.0"
|
||||
in anyErrors := true;
|
||||
print (!fileName);
|
||||
look(!linePos,!lineNum);
|
||||
print ":";
|
||||
print msg;
|
||||
print "\n"
|
||||
end
|
||||
|
||||
fun impossible msg =
|
||||
(app print ["Error: Compiler bug: ",msg,"\n"];
|
||||
TextIO.flushOut TextIO.stdOut;
|
||||
raise Error)
|
||||
|
||||
end (* structure ErrorMsg *)
|
||||
|
||||
22
tiger/chap3/parsetest.sml
Normal file
22
tiger/chap3/parsetest.sml
Normal file
|
|
@ -0,0 +1,22 @@
|
|||
structure Parse : sig val parse : string -> unit end =
|
||||
struct
|
||||
structure TigerLrVals = TigerLrValsFun(structure Token = LrParser.Token)
|
||||
structure Lex = TigerLexFun(structure Tokens = TigerLrVals.Tokens)
|
||||
structure TigerP = Join(structure ParserData = TigerLrVals.ParserData
|
||||
structure Lex=Lex
|
||||
structure LrParser = LrParser)
|
||||
fun parse filename =
|
||||
let val _ = (ErrorMsg.reset(); ErrorMsg.fileName := filename)
|
||||
val file = TextIO.openIn filename
|
||||
fun get _ = TextIO.input file
|
||||
fun parseerror(s,p1,p2) = ErrorMsg.error p1 s
|
||||
val lexer = LrParser.Stream.streamify (Lex.makeLexer get)
|
||||
val (absyn, _) = TigerP.parse(30,lexer,parseerror,())
|
||||
in TextIO.closeIn file;
|
||||
absyn
|
||||
end handle LrParser.ParseError => raise ErrorMsg.Error
|
||||
|
||||
end
|
||||
|
||||
|
||||
|
||||
9
tiger/chap3/sources.cm
Normal file
9
tiger/chap3/sources.cm
Normal file
|
|
@ -0,0 +1,9 @@
|
|||
Group is
|
||||
|
||||
tiger.lex
|
||||
errormsg.sml
|
||||
parsetest.sml
|
||||
tiger.grm
|
||||
smlnj-lib.cm
|
||||
ml-yacc-lib.cm
|
||||
|
||||
38
tiger/chap3/tiger.grm
Normal file
38
tiger/chap3/tiger.grm
Normal file
|
|
@ -0,0 +1,38 @@
|
|||
%%
|
||||
%term
|
||||
EOF
|
||||
| ID of string
|
||||
| INT of int | STRING of string
|
||||
| COMMA | COLON | SEMICOLON | LPAREN | RPAREN | LBRACK | RBRACK
|
||||
| LBRACE | RBRACE | DOT
|
||||
| PLUS | MINUS | TIMES | DIVIDE | EQ | NEQ | LT | LE | GT | GE
|
||||
| AND | OR | ASSIGN
|
||||
| ARRAY | IF | THEN | ELSE | WHILE | FOR | TO | DO | LET | IN | END | OF
|
||||
| BREAK | NIL
|
||||
| FUNCTION | VAR | TYPE
|
||||
|
||||
%nonterm exp | program
|
||||
|
||||
%pos int
|
||||
%verbose
|
||||
%start program
|
||||
%eop EOF
|
||||
%noshift EOF
|
||||
|
||||
%name Tiger
|
||||
|
||||
%keyword WHILE FOR TO BREAK LET IN END FUNCTION VAR TYPE ARRAY IF THEN ELSE
|
||||
DO OF NIL
|
||||
|
||||
%prefer THEN ELSE LPAREN
|
||||
|
||||
%value ID ("bogus")
|
||||
%value INT (1)
|
||||
%value STRING ("")
|
||||
|
||||
%%
|
||||
|
||||
program : exp ()
|
||||
|
||||
|
||||
exp: ()
|
||||
988
tiger/chap3/tiger.lex.sml
Normal file
988
tiger/chap3/tiger.lex.sml
Normal file
|
|
@ -0,0 +1,988 @@
|
|||
(* Copyright (c) 1997 Andrew W. Appel. *)
|
||||
functor TigerLexFun(structure Tokens : Tiger_TOKENS)=
|
||||
struct
|
||||
structure UserDeclarations =
|
||||
struct
|
||||
open ErrorMsg;
|
||||
|
||||
type svalue = Tokens.svalue
|
||||
type pos = int
|
||||
type ('a,'b) token = ('a,'b) Tokens.token
|
||||
type lexresult = (svalue,pos) token
|
||||
|
||||
fun inc x = x := !x + 1
|
||||
fun dec x = x := !x - 1
|
||||
|
||||
val stringstart = ref 0
|
||||
val charlist = ref (nil: char list)
|
||||
val lineNum = ErrorMsg.lineNum
|
||||
val linePos = ErrorMsg.linePos
|
||||
val comLevel = ref 0
|
||||
fun err(p1,p2) = ErrorMsg.error p1
|
||||
|
||||
val eof = fn () =>
|
||||
let val pos = Int.max(!stringstart+2, hd(!linePos))
|
||||
in if !comLevel>0 then err (!stringstart,pos) "unclosed comment"
|
||||
else ();
|
||||
Tokens.EOF(pos,pos)
|
||||
end
|
||||
fun addString (s:char) = charlist := s :: (!charlist)
|
||||
fun makeString () = (implode(rev(!charlist)) before charlist := nil)
|
||||
|
||||
fun makeInt s =
|
||||
foldl (fn (c,a) => a*10 + ord c - ord #"0") 0 (explode s)
|
||||
|
||||
|
||||
end (* end of user routines *)
|
||||
exception LexError (* raised if illegal leaf action tried *)
|
||||
structure Internal =
|
||||
struct
|
||||
|
||||
datatype yyfinstate = N of int
|
||||
type statedata = {fin : yyfinstate list, trans: string}
|
||||
(* transition & final state table *)
|
||||
val tab = let
|
||||
val s = [
|
||||
(0,
|
||||
"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000"
|
||||
),
|
||||
(1,
|
||||
"\010\010\010\010\010\010\010\010\010\096\098\010\096\010\010\010\
|
||||
\\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
|
||||
\\096\010\095\010\010\010\094\010\092\091\089\088\087\086\085\084\
|
||||
\\082\082\082\082\082\082\082\082\082\082\080\079\076\075\073\010\
|
||||
\\010\014\014\014\014\014\014\014\014\014\014\014\014\014\014\014\
|
||||
\\014\014\014\014\014\014\014\014\014\014\014\072\010\071\010\010\
|
||||
\\010\066\061\014\059\053\043\014\014\040\014\014\037\014\034\032\
|
||||
\\014\014\014\014\024\014\021\016\014\014\014\013\012\011\010\010\
|
||||
\\009"
|
||||
),
|
||||
(3,
|
||||
"\099\099\099\099\099\099\099\099\099\099\104\099\099\099\099\099\
|
||||
\\099\099\099\099\099\099\099\099\099\099\099\099\099\099\099\099\
|
||||
\\099\099\099\099\099\099\099\099\102\099\100\099\099\099\099\099\
|
||||
\\099\099\099\099\099\099\099\099\099\099\099\099\099\099\099\099\
|
||||
\\099\099\099\099\099\099\099\099\099\099\099\099\099\099\099\099\
|
||||
\\099\099\099\099\099\099\099\099\099\099\099\099\099\099\099\099\
|
||||
\\099\099\099\099\099\099\099\099\099\099\099\099\099\099\099\099\
|
||||
\\099\099\099\099\099\099\099\099\099\099\099\099\099\099\099\099\
|
||||
\\099"
|
||||
),
|
||||
(5,
|
||||
"\105\105\105\105\105\105\105\105\105\105\119\105\105\105\105\105\
|
||||
\\105\105\105\105\105\105\105\105\105\105\105\105\105\105\105\105\
|
||||
\\105\105\118\105\105\105\105\105\105\105\105\105\105\105\105\105\
|
||||
\\105\105\105\105\105\105\105\105\105\105\105\105\105\105\105\105\
|
||||
\\105\105\105\105\105\105\105\105\105\105\105\105\105\105\105\105\
|
||||
\\105\105\105\105\105\105\105\105\105\105\105\105\106\105\105\105\
|
||||
\\105\105\105\105\105\105\105\105\105\105\105\105\105\105\105\105\
|
||||
\\105\105\105\105\105\105\105\105\105\105\105\105\105\105\105\105\
|
||||
\\105"
|
||||
),
|
||||
(7,
|
||||
"\120\120\120\120\120\120\120\120\120\122\124\120\122\120\120\120\
|
||||
\\120\120\120\120\120\120\120\120\120\120\120\120\120\120\120\120\
|
||||
\\122\120\120\120\120\120\120\120\120\120\120\120\120\120\120\120\
|
||||
\\120\120\120\120\120\120\120\120\120\120\120\120\120\120\120\120\
|
||||
\\120\120\120\120\120\120\120\120\120\120\120\120\120\120\120\120\
|
||||
\\120\120\120\120\120\120\120\120\120\120\120\120\121\120\120\120\
|
||||
\\120\120\120\120\120\120\120\120\120\120\120\120\120\120\120\120\
|
||||
\\120\120\120\120\120\120\120\120\120\120\120\120\120\120\120\120\
|
||||
\\120"
|
||||
),
|
||||
(14,
|
||||
"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\000\
|
||||
\\000\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\
|
||||
\\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\015\
|
||||
\\000\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\
|
||||
\\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\
|
||||
\\000"
|
||||
),
|
||||
(16,
|
||||
"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\000\
|
||||
\\000\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\
|
||||
\\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\015\
|
||||
\\000\015\015\015\015\015\015\015\017\015\015\015\015\015\015\015\
|
||||
\\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\
|
||||
\\000"
|
||||
),
|
||||
(17,
|
||||
"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\000\
|
||||
\\000\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\
|
||||
\\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\015\
|
||||
\\000\015\015\015\015\015\015\015\015\018\015\015\015\015\015\015\
|
||||
\\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\
|
||||
\\000"
|
||||
),
|
||||
(18,
|
||||
"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\000\
|
||||
\\000\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\
|
||||
\\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\015\
|
||||
\\000\015\015\015\015\015\015\015\015\015\015\015\019\015\015\015\
|
||||
\\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\
|
||||
\\000"
|
||||
),
|
||||
(19,
|
||||
"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\000\
|
||||
\\000\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\
|
||||
\\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\015\
|
||||
\\000\015\015\015\015\020\015\015\015\015\015\015\015\015\015\015\
|
||||
\\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\
|
||||
\\000"
|
||||
),
|
||||
(21,
|
||||
"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\000\
|
||||
\\000\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\
|
||||
\\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\015\
|
||||
\\000\022\015\015\015\015\015\015\015\015\015\015\015\015\015\015\
|
||||
\\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\
|
||||
\\000"
|
||||
),
|
||||
(22,
|
||||
"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\000\
|
||||
\\000\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\
|
||||
\\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\015\
|
||||
\\000\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\
|
||||
\\015\015\023\015\015\015\015\015\015\015\015\000\000\000\000\000\
|
||||
\\000"
|
||||
),
|
||||
(24,
|
||||
"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\000\
|
||||
\\000\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\
|
||||
\\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\015\
|
||||
\\000\015\015\015\015\015\015\015\029\015\015\015\015\015\015\028\
|
||||
\\015\015\015\015\015\015\015\015\015\025\015\000\000\000\000\000\
|
||||
\\000"
|
||||
),
|
||||
(25,
|
||||
"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\000\
|
||||
\\000\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\
|
||||
\\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\015\
|
||||
\\000\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\
|
||||
\\026\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\
|
||||
\\000"
|
||||
),
|
||||
(26,
|
||||
"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\000\
|
||||
\\000\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\
|
||||
\\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\015\
|
||||
\\000\015\015\015\015\027\015\015\015\015\015\015\015\015\015\015\
|
||||
\\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\
|
||||
\\000"
|
||||
),
|
||||
(29,
|
||||
"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\000\
|
||||
\\000\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\
|
||||
\\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\015\
|
||||
\\000\015\015\015\015\030\015\015\015\015\015\015\015\015\015\015\
|
||||
\\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\
|
||||
\\000"
|
||||
),
|
||||
(30,
|
||||
"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\000\
|
||||
\\000\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\
|
||||
\\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\015\
|
||||
\\000\015\015\015\015\015\015\015\015\015\015\015\015\015\031\015\
|
||||
\\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\
|
||||
\\000"
|
||||
),
|
||||
(32,
|
||||
"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\000\
|
||||
\\000\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\
|
||||
\\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\015\
|
||||
\\000\015\015\015\015\015\033\015\015\015\015\015\015\015\015\015\
|
||||
\\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\
|
||||
\\000"
|
||||
),
|
||||
(34,
|
||||
"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\000\
|
||||
\\000\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\
|
||||
\\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\015\
|
||||
\\000\015\015\015\015\015\015\015\015\035\015\015\015\015\015\015\
|
||||
\\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\
|
||||
\\000"
|
||||
),
|
||||
(35,
|
||||
"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\000\
|
||||
\\000\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\
|
||||
\\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\015\
|
||||
\\000\015\015\015\015\015\015\015\015\015\015\015\036\015\015\015\
|
||||
\\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\
|
||||
\\000"
|
||||
),
|
||||
(37,
|
||||
"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\000\
|
||||
\\000\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\
|
||||
\\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\015\
|
||||
\\000\015\015\015\015\038\015\015\015\015\015\015\015\015\015\015\
|
||||
\\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\
|
||||
\\000"
|
||||
),
|
||||
(38,
|
||||
"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\000\
|
||||
\\000\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\
|
||||
\\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\015\
|
||||
\\000\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\
|
||||
\\015\015\015\015\039\015\015\015\015\015\015\000\000\000\000\000\
|
||||
\\000"
|
||||
),
|
||||
(40,
|
||||
"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\000\
|
||||
\\000\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\
|
||||
\\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\015\
|
||||
\\000\015\015\015\015\015\042\015\015\015\015\015\015\015\041\015\
|
||||
\\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\
|
||||
\\000"
|
||||
),
|
||||
(43,
|
||||
"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\000\
|
||||
\\000\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\
|
||||
\\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\015\
|
||||
\\000\015\015\015\015\015\015\015\015\015\015\015\015\015\015\051\
|
||||
\\015\015\015\015\015\044\015\015\015\015\015\000\000\000\000\000\
|
||||
\\000"
|
||||
),
|
||||
(44,
|
||||
"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\000\
|
||||
\\000\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\
|
||||
\\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\015\
|
||||
\\000\015\015\015\015\015\015\015\015\015\015\015\015\015\045\015\
|
||||
\\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\
|
||||
\\000"
|
||||
),
|
||||
(45,
|
||||
"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\000\
|
||||
\\000\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\
|
||||
\\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\015\
|
||||
\\000\015\015\046\015\015\015\015\015\015\015\015\015\015\015\015\
|
||||
\\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\
|
||||
\\000"
|
||||
),
|
||||
(46,
|
||||
"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\000\
|
||||
\\000\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\
|
||||
\\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\015\
|
||||
\\000\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\
|
||||
\\015\015\015\015\047\015\015\015\015\015\015\000\000\000\000\000\
|
||||
\\000"
|
||||
),
|
||||
(47,
|
||||
"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\000\
|
||||
\\000\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\
|
||||
\\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\015\
|
||||
\\000\015\015\015\015\015\015\015\015\048\015\015\015\015\015\015\
|
||||
\\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\
|
||||
\\000"
|
||||
),
|
||||
(48,
|
||||
"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\000\
|
||||
\\000\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\
|
||||
\\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\015\
|
||||
\\000\015\015\015\015\015\015\015\015\015\015\015\015\015\015\049\
|
||||
\\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\
|
||||
\\000"
|
||||
),
|
||||
(49,
|
||||
"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\000\
|
||||
\\000\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\
|
||||
\\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\015\
|
||||
\\000\015\015\015\015\015\015\015\015\015\015\015\015\015\050\015\
|
||||
\\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\
|
||||
\\000"
|
||||
),
|
||||
(51,
|
||||
"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\000\
|
||||
\\000\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\
|
||||
\\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\015\
|
||||
\\000\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\
|
||||
\\015\015\052\015\015\015\015\015\015\015\015\000\000\000\000\000\
|
||||
\\000"
|
||||
),
|
||||
(53,
|
||||
"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\000\
|
||||
\\000\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\
|
||||
\\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\015\
|
||||
\\000\015\015\015\015\015\015\015\015\015\015\015\056\015\054\015\
|
||||
\\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\
|
||||
\\000"
|
||||
),
|
||||
(54,
|
||||
"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\000\
|
||||
\\000\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\
|
||||
\\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\015\
|
||||
\\000\015\015\015\055\015\015\015\015\015\015\015\015\015\015\015\
|
||||
\\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\
|
||||
\\000"
|
||||
),
|
||||
(56,
|
||||
"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\000\
|
||||
\\000\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\
|
||||
\\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\015\
|
||||
\\000\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\
|
||||
\\015\015\015\057\015\015\015\015\015\015\015\000\000\000\000\000\
|
||||
\\000"
|
||||
),
|
||||
(57,
|
||||
"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\000\
|
||||
\\000\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\
|
||||
\\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\015\
|
||||
\\000\015\015\015\015\058\015\015\015\015\015\015\015\015\015\015\
|
||||
\\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\
|
||||
\\000"
|
||||
),
|
||||
(59,
|
||||
"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\000\
|
||||
\\000\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\
|
||||
\\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\015\
|
||||
\\000\015\015\015\015\015\015\015\015\015\015\015\015\015\015\060\
|
||||
\\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\
|
||||
\\000"
|
||||
),
|
||||
(61,
|
||||
"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\000\
|
||||
\\000\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\
|
||||
\\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\015\
|
||||
\\000\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\
|
||||
\\015\015\062\015\015\015\015\015\015\015\015\000\000\000\000\000\
|
||||
\\000"
|
||||
),
|
||||
(62,
|
||||
"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\000\
|
||||
\\000\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\
|
||||
\\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\015\
|
||||
\\000\015\015\015\015\063\015\015\015\015\015\015\015\015\015\015\
|
||||
\\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\
|
||||
\\000"
|
||||
),
|
||||
(63,
|
||||
"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\000\
|
||||
\\000\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\
|
||||
\\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\015\
|
||||
\\000\064\015\015\015\015\015\015\015\015\015\015\015\015\015\015\
|
||||
\\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\
|
||||
\\000"
|
||||
),
|
||||
(64,
|
||||
"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\000\
|
||||
\\000\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\
|
||||
\\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\015\
|
||||
\\000\015\015\015\015\015\015\015\015\015\015\065\015\015\015\015\
|
||||
\\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\
|
||||
\\000"
|
||||
),
|
||||
(66,
|
||||
"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\000\
|
||||
\\000\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\
|
||||
\\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\015\
|
||||
\\000\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\
|
||||
\\015\015\067\015\015\015\015\015\015\015\015\000\000\000\000\000\
|
||||
\\000"
|
||||
),
|
||||
(67,
|
||||
"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\000\
|
||||
\\000\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\
|
||||
\\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\015\
|
||||
\\000\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\
|
||||
\\015\015\068\015\015\015\015\015\015\015\015\000\000\000\000\000\
|
||||
\\000"
|
||||
),
|
||||
(68,
|
||||
"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\000\
|
||||
\\000\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\
|
||||
\\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\015\
|
||||
\\000\069\015\015\015\015\015\015\015\015\015\015\015\015\015\015\
|
||||
\\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\
|
||||
\\000"
|
||||
),
|
||||
(69,
|
||||
"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\000\
|
||||
\\000\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\
|
||||
\\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\015\
|
||||
\\000\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\
|
||||
\\015\015\015\015\015\015\015\015\015\070\015\000\000\000\000\000\
|
||||
\\000"
|
||||
),
|
||||
(73,
|
||||
"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\074\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000"
|
||||
),
|
||||
(76,
|
||||
"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\078\077\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000"
|
||||
),
|
||||
(80,
|
||||
"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\081\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000"
|
||||
),
|
||||
(82,
|
||||
"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\083\083\083\083\083\083\083\083\083\083\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000"
|
||||
),
|
||||
(89,
|
||||
"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\090\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000"
|
||||
),
|
||||
(92,
|
||||
"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\093\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000"
|
||||
),
|
||||
(96,
|
||||
"\000\000\000\000\000\000\000\000\000\097\000\000\097\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\097\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000"
|
||||
),
|
||||
(100,
|
||||
"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\101\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000"
|
||||
),
|
||||
(102,
|
||||
"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\103\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000"
|
||||
),
|
||||
(106,
|
||||
"\000\000\000\000\000\000\000\000\000\116\117\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\116\000\115\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\112\112\112\112\112\112\112\112\112\112\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\111\000\109\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\108\000\
|
||||
\\000\000\000\000\107\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000"
|
||||
),
|
||||
(109,
|
||||
"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\110\110\110\110\110\110\110\110\110\110\110\110\110\110\110\110\
|
||||
\\110\110\110\110\110\110\110\110\110\110\110\110\110\110\110\110\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000"
|
||||
),
|
||||
(112,
|
||||
"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\113\113\113\113\113\113\113\113\113\113\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000"
|
||||
),
|
||||
(113,
|
||||
"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\114\114\114\114\114\114\114\114\114\114\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000"
|
||||
),
|
||||
(122,
|
||||
"\000\000\000\000\000\000\000\000\000\123\000\000\123\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\123\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
|
||||
\\000"
|
||||
),
|
||||
(0, "")]
|
||||
fun f x = x
|
||||
val s = map f (rev (tl (rev s)))
|
||||
exception LexHackingError
|
||||
fun look ((j,x)::r, i) = if i = j then x else look(r, i)
|
||||
| look ([], i) = raise LexHackingError
|
||||
fun g {fin=x, trans=i} = {fin=x, trans=look(s,i)}
|
||||
in Vector.fromList(map g
|
||||
[{fin = [], trans = 0},
|
||||
{fin = [(N 2)], trans = 1},
|
||||
{fin = [(N 2)], trans = 1},
|
||||
{fin = [], trans = 3},
|
||||
{fin = [], trans = 3},
|
||||
{fin = [], trans = 5},
|
||||
{fin = [], trans = 5},
|
||||
{fin = [(N 174)], trans = 7},
|
||||
{fin = [(N 174)], trans = 7},
|
||||
{fin = [(N 147),(N 149)], trans = 0},
|
||||
{fin = [(N 149)], trans = 0},
|
||||
{fin = [(N 10),(N 149)], trans = 0},
|
||||
{fin = [(N 36),(N 149)], trans = 0},
|
||||
{fin = [(N 8),(N 149)], trans = 0},
|
||||
{fin = [(N 134),(N 149)], trans = 14},
|
||||
{fin = [(N 134)], trans = 14},
|
||||
{fin = [(N 134),(N 149)], trans = 16},
|
||||
{fin = [(N 134)], trans = 17},
|
||||
{fin = [(N 134)], trans = 18},
|
||||
{fin = [(N 134)], trans = 19},
|
||||
{fin = [(N 64),(N 134)], trans = 14},
|
||||
{fin = [(N 134),(N 149)], trans = 21},
|
||||
{fin = [(N 134)], trans = 22},
|
||||
{fin = [(N 101),(N 134)], trans = 14},
|
||||
{fin = [(N 134),(N 149)], trans = 24},
|
||||
{fin = [(N 134)], trans = 25},
|
||||
{fin = [(N 134)], trans = 26},
|
||||
{fin = [(N 106),(N 134)], trans = 14},
|
||||
{fin = [(N 84),(N 134)], trans = 14},
|
||||
{fin = [(N 134)], trans = 29},
|
||||
{fin = [(N 134)], trans = 30},
|
||||
{fin = [(N 120),(N 134)], trans = 14},
|
||||
{fin = [(N 134),(N 149)], trans = 32},
|
||||
{fin = [(N 131),(N 134)], trans = 14},
|
||||
{fin = [(N 134),(N 149)], trans = 34},
|
||||
{fin = [(N 134)], trans = 35},
|
||||
{fin = [(N 81),(N 134)], trans = 14},
|
||||
{fin = [(N 134),(N 149)], trans = 37},
|
||||
{fin = [(N 134)], trans = 38},
|
||||
{fin = [(N 74),(N 134)], trans = 14},
|
||||
{fin = [(N 134),(N 149)], trans = 40},
|
||||
{fin = [(N 77),(N 134)], trans = 14},
|
||||
{fin = [(N 115),(N 134)], trans = 14},
|
||||
{fin = [(N 134),(N 149)], trans = 43},
|
||||
{fin = [(N 134)], trans = 44},
|
||||
{fin = [(N 134)], trans = 45},
|
||||
{fin = [(N 134)], trans = 46},
|
||||
{fin = [(N 134)], trans = 47},
|
||||
{fin = [(N 134)], trans = 48},
|
||||
{fin = [(N 134)], trans = 49},
|
||||
{fin = [(N 97),(N 134)], trans = 14},
|
||||
{fin = [(N 134)], trans = 51},
|
||||
{fin = [(N 58),(N 134)], trans = 14},
|
||||
{fin = [(N 134),(N 149)], trans = 53},
|
||||
{fin = [(N 134)], trans = 54},
|
||||
{fin = [(N 88),(N 134)], trans = 14},
|
||||
{fin = [(N 134)], trans = 56},
|
||||
{fin = [(N 134)], trans = 57},
|
||||
{fin = [(N 125),(N 134)], trans = 14},
|
||||
{fin = [(N 134),(N 149)], trans = 59},
|
||||
{fin = [(N 128),(N 134)], trans = 14},
|
||||
{fin = [(N 134),(N 149)], trans = 61},
|
||||
{fin = [(N 134)], trans = 62},
|
||||
{fin = [(N 134)], trans = 63},
|
||||
{fin = [(N 134)], trans = 64},
|
||||
{fin = [(N 70),(N 134)], trans = 14},
|
||||
{fin = [(N 134),(N 149)], trans = 66},
|
||||
{fin = [(N 134)], trans = 67},
|
||||
{fin = [(N 134)], trans = 68},
|
||||
{fin = [(N 134)], trans = 69},
|
||||
{fin = [(N 112),(N 134)], trans = 14},
|
||||
{fin = [(N 14),(N 149)], trans = 0},
|
||||
{fin = [(N 12),(N 149)], trans = 0},
|
||||
{fin = [(N 46),(N 149)], trans = 73},
|
||||
{fin = [(N 51)], trans = 0},
|
||||
{fin = [(N 41),(N 149)], trans = 0},
|
||||
{fin = [(N 48),(N 149)], trans = 76},
|
||||
{fin = [(N 44)], trans = 0},
|
||||
{fin = [(N 54)], trans = 0},
|
||||
{fin = [(N 18),(N 149)], trans = 0},
|
||||
{fin = [(N 16),(N 149)], trans = 80},
|
||||
{fin = [(N 39)], trans = 0},
|
||||
{fin = [(N 137),(N 149)], trans = 82},
|
||||
{fin = [(N 137)], trans = 82},
|
||||
{fin = [(N 32),(N 149)], trans = 0},
|
||||
{fin = [(N 24),(N 149)], trans = 0},
|
||||
{fin = [(N 28),(N 149)], trans = 0},
|
||||
{fin = [(N 6),(N 149)], trans = 0},
|
||||
{fin = [(N 26),(N 149)], trans = 0},
|
||||
{fin = [(N 30),(N 149)], trans = 89},
|
||||
{fin = [(N 145)], trans = 0},
|
||||
{fin = [(N 22),(N 149)], trans = 0},
|
||||
{fin = [(N 20),(N 149)], trans = 92},
|
||||
{fin = [(N 142)], trans = 0},
|
||||
{fin = [(N 34),(N 149)], trans = 0},
|
||||
{fin = [(N 139),(N 149)], trans = 0},
|
||||
{fin = [(N 2),(N 149)], trans = 96},
|
||||
{fin = [(N 2)], trans = 96},
|
||||
{fin = [(N 4)], trans = 0},
|
||||
{fin = [(N 159)], trans = 0},
|
||||
{fin = [(N 159)], trans = 100},
|
||||
{fin = [(N 157)], trans = 0},
|
||||
{fin = [(N 159)], trans = 102},
|
||||
{fin = [(N 152)], trans = 0},
|
||||
{fin = [(N 154)], trans = 0},
|
||||
{fin = [(N 203)], trans = 0},
|
||||
{fin = [(N 201),(N 203)], trans = 106},
|
||||
{fin = [(N 181)], trans = 0},
|
||||
{fin = [(N 184)], trans = 0},
|
||||
{fin = [], trans = 109},
|
||||
{fin = [(N 194)], trans = 0},
|
||||
{fin = [(N 187)], trans = 0},
|
||||
{fin = [], trans = 112},
|
||||
{fin = [], trans = 113},
|
||||
{fin = [(N 199)], trans = 0},
|
||||
{fin = [(N 190)], trans = 0},
|
||||
{fin = [(N 169)], trans = 0},
|
||||
{fin = [(N 166)], trans = 0},
|
||||
{fin = [(N 161),(N 203)], trans = 0},
|
||||
{fin = [(N 163)], trans = 0},
|
||||
{fin = [(N 178)], trans = 0},
|
||||
{fin = [(N 176),(N 178)], trans = 0},
|
||||
{fin = [(N 174),(N 178)], trans = 122},
|
||||
{fin = [(N 174)], trans = 122},
|
||||
{fin = [(N 171)], trans = 0}])
|
||||
end
|
||||
structure StartStates =
|
||||
struct
|
||||
datatype yystartstate = STARTSTATE of int
|
||||
|
||||
(* start state definitions *)
|
||||
|
||||
val A = STARTSTATE 3;
|
||||
val F = STARTSTATE 7;
|
||||
val INITIAL = STARTSTATE 1;
|
||||
val S = STARTSTATE 5;
|
||||
|
||||
end
|
||||
type result = UserDeclarations.lexresult
|
||||
exception LexerError (* raised if illegal leaf action tried *)
|
||||
end
|
||||
|
||||
fun makeLexer yyinput =
|
||||
let
|
||||
val yyb = ref "\n" (* buffer *)
|
||||
val yybl = ref 1 (*buffer length *)
|
||||
val yybufpos = ref 1 (* location of next character to use *)
|
||||
val yygone = ref 1 (* position in file of beginning of buffer *)
|
||||
val yydone = ref false (* eof found yet? *)
|
||||
val yybegin = ref 1 (*Current 'start state' for lexer *)
|
||||
|
||||
val YYBEGIN = fn (Internal.StartStates.STARTSTATE x) =>
|
||||
yybegin := x
|
||||
|
||||
fun lex () : Internal.result =
|
||||
let fun continue() = lex() in
|
||||
let fun scan (s,AcceptingLeaves : Internal.yyfinstate list list,l,i0) =
|
||||
let fun action (i,nil) = raise LexError
|
||||
| action (i,nil::l) = action (i-1,l)
|
||||
| action (i,(node::acts)::l) =
|
||||
case node of
|
||||
Internal.N yyk =>
|
||||
(let val yytext = substring(!yyb,i0,i-i0)
|
||||
val yypos = i0+ !yygone
|
||||
open UserDeclarations Internal.StartStates
|
||||
in (yybufpos := i; case yyk of
|
||||
|
||||
(* Application actions *)
|
||||
|
||||
10 => (Tokens.RBRACE(yypos,yypos+1))
|
||||
| 101 => (Tokens.VAR(yypos,yypos+3))
|
||||
| 106 => (Tokens.TYPE(yypos,yypos+4))
|
||||
| 112 => (Tokens.ARRAY(yypos,yypos+5))
|
||||
| 115 => (Tokens.IF(yypos,yypos+2))
|
||||
| 12 => (Tokens.LBRACK(yypos,yypos+1))
|
||||
| 120 => (Tokens.THEN(yypos,yypos+4))
|
||||
| 125 => (Tokens.ELSE(yypos,yypos+4))
|
||||
| 128 => (Tokens.DO(yypos,yypos+2))
|
||||
| 131 => (Tokens.OF(yypos,yypos+2))
|
||||
| 134 => (Tokens.ID(yytext,yypos,yypos+size yytext))
|
||||
| 137 => (Tokens.INT(makeInt yytext
|
||||
handle Overflow => (err (yypos,yypos+size yytext)
|
||||
"integer too large";
|
||||
1),
|
||||
yypos,yypos+size yytext))
|
||||
| 139 => (charlist := nil; stringstart := yypos;
|
||||
YYBEGIN S; continue())
|
||||
| 14 => (Tokens.RBRACK(yypos,yypos+1))
|
||||
| 142 => (YYBEGIN A; stringstart := yypos; comLevel := 1; continue())
|
||||
| 145 => (err (yypos,yypos+1) "unmatched close comment";
|
||||
continue())
|
||||
| 147 => (err (yypos,yypos) "non-Ascii character";
|
||||
continue())
|
||||
| 149 => (err (yypos,yypos) "illegal token";
|
||||
continue())
|
||||
| 152 => (inc comLevel; continue())
|
||||
| 154 => (inc lineNum; linePos := yypos :: !linePos; continue())
|
||||
| 157 => (dec comLevel; if !comLevel=0 then YYBEGIN INITIAL else (); continue())
|
||||
| 159 => (continue())
|
||||
| 16 => (Tokens.COLON(yypos,yypos+1))
|
||||
| 161 => (YYBEGIN INITIAL; Tokens.STRING(makeString(),
|
||||
!stringstart,yypos+1))
|
||||
| 163 => (err (!stringstart,yypos) "unclosed string";
|
||||
inc lineNum; linePos := yypos :: !linePos;
|
||||
YYBEGIN INITIAL; Tokens.STRING(makeString(),!stringstart,yypos))
|
||||
| 166 => (inc lineNum; linePos := yypos :: !linePos;
|
||||
YYBEGIN F; continue())
|
||||
| 169 => (YYBEGIN F; continue())
|
||||
| 171 => (inc lineNum; linePos := yypos :: !linePos; continue())
|
||||
| 174 => (continue())
|
||||
| 176 => (YYBEGIN S; stringstart := yypos; continue())
|
||||
| 178 => (err (!stringstart,yypos) "unclosed string";
|
||||
YYBEGIN INITIAL; Tokens.STRING(makeString(),!stringstart,yypos+1))
|
||||
| 18 => (Tokens.SEMICOLON(yypos,yypos+1))
|
||||
| 181 => (addString #"\t"; continue())
|
||||
| 184 => (addString #"\n"; continue())
|
||||
| 187 => (addString #"\\"; continue())
|
||||
| 190 => (addString #"\""; continue())
|
||||
| 194 => (addString(chr(ord(String.sub(yytext,2))-ord(#"@")));
|
||||
continue())
|
||||
| 199 => (let val x = ord(String.sub(yytext,1))*100
|
||||
+ord(String.sub(yytext,2))*10
|
||||
+ord(String.sub(yytext,3))
|
||||
-(ord #"0" * 111)
|
||||
in (if x>255
|
||||
then err (yypos,yypos+4) "illegal ascii escape"
|
||||
else addString(chr x);
|
||||
continue())
|
||||
end)
|
||||
| 2 => (continue())
|
||||
| 20 => (Tokens.LPAREN(yypos,yypos+1))
|
||||
| 201 => (err (yypos,yypos+1) "illegal string escape";
|
||||
continue())
|
||||
| 203 => (addString(String.sub(yytext,0)); continue())
|
||||
| 22 => (Tokens.RPAREN(yypos,yypos+1))
|
||||
| 24 => (Tokens.DOT(yypos,yypos+1))
|
||||
| 26 => (Tokens.PLUS(yypos,yypos+1))
|
||||
| 28 => (Tokens.MINUS(yypos,yypos+1))
|
||||
| 30 => (Tokens.TIMES(yypos,yypos+1))
|
||||
| 32 => (Tokens.DIVIDE(yypos,yypos+1))
|
||||
| 34 => (Tokens.AND(yypos,yypos+1))
|
||||
| 36 => (Tokens.OR(yypos,yypos+1))
|
||||
| 39 => (Tokens.ASSIGN(yypos,yypos+2))
|
||||
| 4 => (inc lineNum; linePos := yypos :: !linePos; continue())
|
||||
| 41 => (Tokens.EQ(yypos,yypos+1))
|
||||
| 44 => (Tokens.NEQ(yypos,yypos+2))
|
||||
| 46 => (Tokens.GT(yypos,yypos+1))
|
||||
| 48 => (Tokens.LT(yypos,yypos+1))
|
||||
| 51 => (Tokens.GE(yypos,yypos+2))
|
||||
| 54 => (Tokens.LE(yypos,yypos+2))
|
||||
| 58 => (Tokens.FOR(yypos,yypos+3))
|
||||
| 6 => (Tokens.COMMA(yypos,yypos+1))
|
||||
| 64 => (Tokens.WHILE(yypos,yypos+5))
|
||||
| 70 => (Tokens.WHILE(yypos,yypos+5))
|
||||
| 74 => (Tokens.LET(yypos,yypos+3))
|
||||
| 77 => (Tokens.IN(yypos,yypos+2))
|
||||
| 8 => (Tokens.LBRACE(yypos,yypos+1))
|
||||
| 81 => (Tokens.NIL(yypos,yypos+3))
|
||||
| 84 => (Tokens.TO(yypos,yypos+2))
|
||||
| 88 => (Tokens.END(yypos,yypos+3))
|
||||
| 97 => (Tokens.FUNCTION(yypos,yypos+8))
|
||||
| _ => raise Internal.LexerError
|
||||
|
||||
) end )
|
||||
|
||||
val {fin,trans} = Vector.sub(Internal.tab, s)
|
||||
val NewAcceptingLeaves = fin::AcceptingLeaves
|
||||
in if l = !yybl then
|
||||
if trans = #trans(Vector.sub(Internal.tab,0))
|
||||
then action(l,NewAcceptingLeaves
|
||||
) else let val newchars= if !yydone then "" else yyinput 1024
|
||||
in if (size newchars)=0
|
||||
then (yydone := true;
|
||||
if (l=i0) then UserDeclarations.eof ()
|
||||
else action(l,NewAcceptingLeaves))
|
||||
else (if i0=l then yyb := newchars
|
||||
else yyb := substring(!yyb,i0,l-i0)^newchars;
|
||||
yygone := !yygone+i0;
|
||||
yybl := size (!yyb);
|
||||
scan (s,AcceptingLeaves,l-i0,0))
|
||||
end
|
||||
else let val NewChar = Char.ord(String.sub(!yyb,l))
|
||||
val NewState = if NewChar<128 then Char.ord(String.sub(trans,NewChar)) else Char.ord(String.sub(trans,128))
|
||||
in if NewState=0 then action(l,NewAcceptingLeaves)
|
||||
else scan(NewState,NewAcceptingLeaves,l+1,i0)
|
||||
end
|
||||
end
|
||||
(*
|
||||
val start= if substring(!yyb,!yybufpos-1,1)="\n"
|
||||
then !yybegin+1 else !yybegin
|
||||
*)
|
||||
in scan(!yybegin (* start *),nil,!yybufpos,!yybufpos)
|
||||
end
|
||||
end
|
||||
in lex
|
||||
end
|
||||
end
|
||||
Loading…
Add table
Add a link
Reference in a new issue