-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
-- All rights reserved.
-- Copyright (C) 2007-2011, Gabriel Dos Reis.
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
-- modification, are permitted provided that the following conditions are
-- met:
--
--     - Redistributions of source code must retain the above copyright
--       notice, this list of conditions and the following disclaimer.
--
--     - Redistributions in binary form must reproduce the above copyright
--       notice, this list of conditions and the following disclaimer in
--       the documentation and/or other materials provided with the
--       distribution.
--
--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
--       names of its contributors may be used to endorse or promote products
--       derived from this software without specific prior written permission.
--
-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

import sys_-macros
import astr
namespace BOOT
module posit where
  %Position <=> %List %Form
  tokType: %List %Form -> %Symbol
  tokPart: %List %Form -> %Thing
  tokPosn: %List %Form -> %Position

$nopos ==
  ['noposition]

poNoPosition()    == $nopos
pfNoPosition() == poNoPosition()
 
poNoPosition? pos == pos is ["noposition",:.]
pfNoPosition? pos == poNoPosition? pos
 
pfSourceText pf ==
    lnString poGetLineObject pfPosn pf
 
pfPosOrNopos pf ==
    poIsPos? (pos := pfSourcePosition pf) => pos
    poNoPosition()
 
poIsPos? pos ==
    cons? pos and cons? first pos and #first pos = 5
 
lnCreate(extBl, st, gNo, :optFileStuff) ==
    lNo :=
        num := IFCAR optFileStuff => num
        0
    fN  := IFCAR IFCDR optFileStuff
    [extBl, st, gNo, lNo, fN]
 
lnString lineObject ==
    lineObject.1
 
lnExtraBlanks lineObject ==
    lineObject.0
 
lnGlobalNum lineObject   ==
    lineObject.2
 
lnSetGlobalNum(lineObject, num) ==
    lineObject.2 := num
 
lnLocalNum lineObject    ==
    lineObject.3
 
lnFileName lineObject    ==
    (fN := lnFileName? lineObject)  => fN
    ncBug('"there is no file name in %1", [lineObject] )
 
lnFileName? lineObject   ==
    (fN := lineObject.4) isnt [.,:.]  => nil
    fN
 
lnPlaceOfOrigin lineObject ==
    lineObject.4
 
lnImmediate? lineObject  ==
    not lnFileName? lineObject
 
poGetLineObject posn ==
    first posn

pfGetLineObject posn == poGetLineObject posn
 
pfSourceStok x==
       if pfLeaf? x
       then x
       else if null pfParts x
            then 'NoToken
            else pfSourceStok pfFirst x
 
pfSourceToken form ==
    if pfLeaf? form
    then pfLeafToken form
    else if null pfParts form
         then 'NoToken
         else pfSourceToken(pfFirst form)

--constructer and selectors for leaf tokens

tokConstruct(hd,tok,:pos)==
         a := [hd,:tok]
         IFCAR pos =>
             pfNoPosition? first pos=> a
             ncPutQ(a,"posn",first pos)
             a
         a

tokType x== ncTag x

tokPart x== rest x

tokPosn x==
     a := objectAssoc("posn",ncAlist x)
     if a then rest a else pfNoPosition()

pfAbSynOp form ==
    hd := first form
    IFCAR hd or hd

pfAbSynOp?(form, op) ==
    hd := first form
    sameObject?(hd, op) or hd is [=op,:.]

pfLeaf? form ==
  pfAbSynOp form in
       '(id idsy symbol string char float expression integer
          Document error)

pfLeaf(x,y,:z)      == tokConstruct(x,y, IFCAR z or pfNoPosition())
pfLeafToken form    == tokPart form
pfLeafPosition form == tokPosn form

pfTree(x,y)   == [x,:y]
pfParts  form == rest form
pfFirst  form == second form
pfSecond form == third form

pfPosn pf == pfSourcePosition pf
 
pfSourcePosition form ==
    --null form => pfNoPosition()
    pfLeaf? form => pfLeafPosition form
    parts := pfParts form
    pos := $nopos
    for p in parts while poNoPosition? pos repeat
        pos := pfSourcePosition p
    pos
 
pfSourcePositions form ==
    if pfLeaf? form
    then
     a:=tokPosn form
     if null a
     then nil
     else [a]
    else  pfSourcePositionlist pfParts form
 
pfSourcePositionlist x==
      if null x
      then nil
      else append(pfSourcePositions first x,pfSourcePositionlist rest x)
 
 
poCharPosn posn == rest posn

pfCharPosn posn == poCharPosn posn
 
poLinePosn posn       ==
    posn => lnLocalNum  poGetLineObject posn  --vector? posn =>
    CDAR posn

pfLinePosn posn == poLinePosn posn
 
poGlobalLinePosn posn ==
    posn => lnGlobalNum poGetLineObject posn
    ncBug('"old style pos objects have no global positions",[])

pfGlobalLinePosn posn == poGlobalLinePosn posn
 
poFileName posn       ==
    posn => lnFileName poGetLineObject posn
    CAAR posn

pfFileName posn == poFileName posn
 
poFileName? posn       ==
    posn = ['noposition] => nil
    posn => lnFileName? poGetLineObject posn
    CAAR posn

pfFileName? posn == poFileName? posn
 
poPlaceOfOrigin posn ==
    lnPlaceOfOrigin poGetLineObject posn

pfPlaceOfOrigin posn == poPlaceOfOrigin posn
 
poNopos? posn ==
    posn = ['noposition]

pfNopos? posn == poNopos? posn

poPosImmediate? txp==
    poNopos? txp => nil
    lnImmediate? poGetLineObject txp

pfPosImmediate? txp == poPosImmediate? txp
 
poImmediate? txp==
    lnImmediate? poGetLineObject txp

pfImmediate? txp == poImmediate? txp
 
 
compareposns(a,b)==
 c:=poGlobalLinePosn a
 d:=poGlobalLinePosn b
 if c=d then poCharPosn a>=poCharPosn b else c>=d

pfPrintSrcLines(pf) ==
  lines := pfSourcePositions pf
  lno := 0
  for l in lines repeat
    line := first l
    if lno < lnGlobalNum(line) then 
      FORMAT(true, '"   ~A~%",  lnString line)
      lno := lnGlobalNum(line)