diff options
Diffstat (limited to 'src/boot')
| -rw-r--r-- | src/boot/ast.boot | 3 | ||||
| -rw-r--r-- | src/boot/includer.boot | 100 |
2 files changed, 56 insertions, 47 deletions
diff --git a/src/boot/ast.boot b/src/boot/ast.boot index ca85928a..2e62c119 100644 --- a/src/boot/ast.boot +++ b/src/boot/ast.boot @@ -736,7 +736,8 @@ bfReName x== oldName := bfGetOldBootName x if newName ^= oldName then warn [PNAME x, '" as `", PNAME newName, _ - '"_' differs from Old Boot `", PNAME oldName, '"_'"] + '"_' differs from Old Boot `", PNAME oldName,_ + '"_' at ", diagnosticLocation $stok] oldName newName diff --git a/src/boot/includer.boot b/src/boot/includer.boot index 53558b27..27f0c5ab 100644 --- a/src/boot/includer.boot +++ b/src/boot/includer.boot @@ -77,7 +77,7 @@ PNAME x == char x == CHAR(PNAME x, 0) -EQCAR(x,y)== CONSP x and EQ(CAR x,y) +EQCAR(x,y)== CONSP x and EQ(first x,y) -- returns the string representation of object X. STRINGIMAGE x == @@ -96,7 +96,7 @@ shoeNotFound fn == shoeReadLispString(s,n) == l:=# s n >= l => nil - READ_-FROM_-STRING CONCAT ( "(", SUBSTRING(s,n,l-n) ,")") + READ_-FROM_-STRING strconc ( "(", SUBSTRING(s,n,l-n) ,")") -- read a line from stream shoeReadLine stream == @@ -108,10 +108,18 @@ shoeConsole line == shoeSpaces n == MAKE_-FULL_-CVEC(n, '".") + +--% + +diagnosticLocation tok == + pos := shoeTokPosn tok + strconc('"line ", STRINGIMAGE lineNo pos, '", column ", + STRINGIMAGE lineCharacter pos) + SoftShoeError(posn,key)== coreError ['"in line ", STRINGIMAGE lineNo posn] shoeConsole lineString posn - shoeConsole CONCAT(shoeSpaces lineCharacter posn,'"|") + shoeConsole strconc(shoeSpaces lineCharacter posn,'"|") shoeConsole key bpSpecificErrorAtToken(tok, key) == @@ -123,30 +131,30 @@ bpSpecificErrorHere(key) == bpSpecificErrorAtToken($stok, key) bpGeneralErrorHere() == bpSpecificErrorHere('"syntax error") bpIgnoredFromTo(pos1, pos2) == - shoeConsole CONCAT('"ignored from line ", STRINGIMAGE lineNo pos1) + shoeConsole strconc('"ignored from line ", STRINGIMAGE lineNo pos1) shoeConsole lineString pos1 - shoeConsole CONCAT(shoeSpaces lineCharacter pos1,'"|") - shoeConsole CONCAT('"ignored through line ", STRINGIMAGE lineNo pos2) + shoeConsole strconc(shoeSpaces lineCharacter pos1,'"|") + shoeConsole strconc('"ignored through line ", STRINGIMAGE lineNo pos2) shoeConsole lineString pos2 - shoeConsole CONCAT(shoeSpaces lineCharacter pos2,'"|") + shoeConsole strconc(shoeSpaces lineCharacter pos2,'"|") -- Line inclusion support. lineNo p==CDAAR p lineString p==CAAAR p -lineCharacter p==CDR p +lineCharacter p==rest p shoePackageStartsAt (lines,sz,name,stream)== bStreamNull stream => [[],['nullstream]] a:=CAAR stream if #a >= 8 and SUBSTRING(a,0,8)='")package" - then shoePackageStartsAt(cons(CAAR stream,lines),sz,name,CDR stream) + then shoePackageStartsAt(cons(CAAR stream,lines),sz,name,rest stream) else if #a<sz - then shoePackageStartsAt(lines, sz,name,CDR stream) + then shoePackageStartsAt(lines, sz,name,rest stream) else if SUBSTRING(a,0,sz)=name and (#a>sz and not shoeIdChar(a.sz)) then [lines,stream] - else shoePackageStartsAt(lines,sz,name,CDR stream) + else shoePackageStartsAt(lines,sz,name,rest stream) shoeFindLines(fn,name,a)== if null a @@ -159,12 +167,12 @@ shoeFindLines(fn,name,a)== b:=shoeTransform2 b if bStreamNull b then - shoeConsole CONCAT (name,'" not found in ",fn) + shoeConsole strconc (name,'" not found in ",fn) [] else if null lines then shoeConsole '")package not found" - append(reverse lines,car b) + append(reverse lines,first b) -- Lazy inclusion support. @@ -174,8 +182,8 @@ bStreamNull x== null x or EQCAR (x,"nullstream") => true while EQCAR(x,"nonnullstream") repeat st:=APPLY(CADR x,CDDR x) - RPLACA(x,CAR st) - RPLACD(x,CDR st) + RPLACA(x,first st) + RPLACD(x,rest st) EQCAR(x,"nullstream") bMap(f,x)==bDelay(function bMap1, [f,x]) @@ -184,14 +192,14 @@ bMap1(:z)== [f,x]:=z if bStreamNull x then $bStreamNil - else cons(FUNCALL(f,car x),bMap(f,cdr x)) + else cons(FUNCALL(f,first x),bMap(f,rest x)) shoeFileMap(f, fn)== a:=shoeInputFile fn null a => - shoeConsole CONCAT(fn,'" NOT FOUND") + shoeConsole strconc(fn,'" NOT FOUND") $bStreamNil - shoeConsole CONCAT('"READING ",fn) + shoeConsole strconc('"READING ",fn) shoeInclude bAddLineNumber(bMap(f,bRgen a),bIgen 0) @@ -200,7 +208,7 @@ bDelay(f,x)==cons("nonnullstream",[f,:x]) bAppend(x,y)==bDelay(function bAppend1,[x,y]) bAppend1(:z)== - if bStreamNull car z + if bStreamNull first z then if bStreamNull CADR z then ["nullstream"] else CADR z @@ -211,22 +219,22 @@ bNext(f,s)==bDelay(function bNext1,[f,s]) bNext1(f,s)== bStreamNull s=> ["nullstream"] h:= APPLY(f, [s]) - bAppend(car h,bNext(f,cdr h)) + bAppend(first h,bNext(f,rest h)) bRgen s==bDelay(function bRgen1,[s]) bRgen1(:s) == - a:=shoeReadLine car s + a:=shoeReadLine first s if shoePLACEP a then --- shoeCLOSE car s +-- shoeCLOSE first s ["nullstream"] - else cons(a,bRgen car s) + else cons(a,bRgen first s) bIgen n==bDelay(function bIgen1,[n]) bIgen1(:n)== - n:=car n+1 + n:=first n+1 cons(n,bIgen n) bAddLineNumber(f1,f2)==bDelay(function bAddLineNumber1,[f1,f2]) @@ -235,16 +243,16 @@ bAddLineNumber1(:f)== [f1,f2] := f bStreamNull f1 => ["nullstream"] bStreamNull f2 => ["nullstream"] - cons(cons(CAR f1,CAR f2),bAddLineNumber(CDR f1,CDR f2)) + cons(cons(first f1,first f2),bAddLineNumber(rest f1,rest f2)) shoeFileInput fn==shoeFileMap(function IDENTITY,fn) -shoePrefixLisp x== CONCAT('")lisp",x) +shoePrefixLisp x== strconc('")lisp",x) shoeLispFileInput fn== shoeFileMap(function shoePrefixLisp,fn) -shoePrefixLine x== CONCAT('")line",x) +shoePrefixLine x== strconc('")line",x) shoeLineFileInput fn== shoeFileMap(function shoePrefixLine,fn) shoePrefix?(prefix,whole) == @@ -284,15 +292,15 @@ shoeFileName x== a:=shoeBiteOff x null a => '"" c:=shoeBiteOff CADR a - null c => CAR a - CONCAT(CAR a,'".",CAR c) + null c => first a + strconc(first a,'".",first c) shoeFnFileName x== a:=shoeBiteOff x null a => ['"",'""] c:=shoeFileName CADR a - null c => [CAR a,'""] - [CAR a, c] + null c => [first a,'""] + [first a, c] shoeFunctionFileInput [fun,fn]== shoeOpenInputFile (a,fn, @@ -302,13 +310,13 @@ shoeInclude s== bDelay(function shoeInclude1,[s]) shoeInclude1 s== bStreamNull s=> s [h,:t] :=s - string :=CAR h + string :=first h command :=shoeFin? string => $bStreamNil command :=shoeIf? string => shoeThen([true],[STTOMC command],t) bAppend(shoeSimpleLine h,shoeInclude t) shoeSimpleLine(h) == - string :=CAR h + string :=first h shoePlainLine? string=> [h] command:=shoeLisp? string => [h] command:=shoeIncludeLisp? string => @@ -333,10 +341,10 @@ shoeThen(keep,b,s)== bDelay(function shoeThen1,[keep,b,s]) shoeThen1(keep,b,s)== bPremStreamNull s=> s [h,:t] :=s - string :=CAR h + string :=first h command :=shoeFin? string => bPremStreamNil(h) - keep1:= car keep - b1 := car b + keep1:= first keep + b1 := first b command :=shoeIf? string => keep1 and b1=> shoeThen(cons(true,keep),cons(STTOMC command,b),t) shoeThen(cons(false,keep),cons(false,b),t) @@ -348,7 +356,7 @@ shoeThen1(keep,b,s)== keep1 and not b1=>shoeElse(cons(true,rest keep),cons(true,rest b),t) shoeElse(cons(false,rest keep),cons(false,rest b),t) command :=shoeEndIf? string=> - null cdr b=> shoeInclude t + null rest b=> shoeInclude t shoeThen(rest keep,rest b,t) keep1 and b1 => bAppend(shoeSimpleLine h,shoeThen(keep,b,t)) shoeThen(keep,b,t) @@ -357,28 +365,28 @@ shoeElse(keep,b,s)== bDelay(function shoeElse1,[keep,b,s]) shoeElse1(keep,b,s)== bPremStreamNull s=> s [h,:t] :=s - string :=CAR h + string :=first h command :=shoeFin? string => bPremStreamNil(h) - b1:=car b - keep1:=car keep + b1:=first b + keep1:=first keep command :=shoeIf? string=> keep1 and b1=> shoeThen(cons(true,keep),cons(STTOMC command,b),t) shoeThen(cons(false,keep),cons(false,b),t) command :=shoeEndIf? string => - null cdr b=> shoeInclude t + null rest b=> shoeInclude t shoeThen(rest keep,rest b,t) keep1 and b1 => bAppend(shoeSimpleLine h,shoeElse(keep,b,t)) shoeElse(keep,b,t) shoeLineSyntaxError(h)== - shoeConsole CONCAT('"INCLUSION SYNTAX ERROR IN LINE ", - STRINGIMAGE CDR h) - shoeConsole car h + shoeConsole strconc('"INCLUSION SYNTAX ERROR IN LINE ", + STRINGIMAGE rest h) + shoeConsole first h shoeConsole '"LINE IGNORED" bPremStreamNil(h)== - shoeConsole CONCAT('"UNEXPECTED )fin IN LINE ",STRINGIMAGE CDR h) - shoeConsole car h + shoeConsole strconc('"UNEXPECTED )fin IN LINE ",STRINGIMAGE rest h) + shoeConsole first h shoeConsole '"REST OF FILE IGNORED" $bStreamNil |