A. Helpers

# multiline strings may be achieved by addition of a new
# parser filter
# We give here a full answer which goes a bit out the scope
# of a basic tutorial, but emphasizes the power of Pliant reflexiveness.
#

module "/pliant/language/parser.pli"
module "/pliant/language/compiler.pli"

#
# parser filter declaration helper function
#     mod is the module in which the filter is declared
#     section_name is the section in which the filter is inserted
#     ad is the address of the filter function
#     adp is the address of the filter parameter
#
function declare_filter2 mod section_name ad adp
  arg_rw Module mod; arg Str section_name; arg Address ad; arg Arrow adp
  var Link:ParserFilter lp :> new ParserFilter
  lp function :> ad map Function
  lp parameter := adp
  mod define section_name addressof:lp

#
# declare_filter meta
#
#    syntax: declare_filter section filter parameter [link|copy]
# inserts the filter 'filter' in section 'section' of the caller's module
# with parameter 'parameter'; By default, parameter is copied.
# parameter may be mapped by using 'link' keyword
#

meta declare_filter e
  if (e:size <> 2) and (e:size<>3) and (e:size<>4)
     return
  var Bool copy:=true
  if e:size=4
     if not e:3:is_pure_ident
        return
     if e:3:ident="copy"
        copy:=true
     eif e:3:ident="link"
        copy:=false
     else
        return
  var Link:Expression ef :> expression immediat (the_function fun ParserContext Str Address) substitute fun e:1 near e
  var Address ad := ef evaluate
  if error_notified
    return
  if ad=null
    error error_id_unexpected "Failed to evaluate expression at "+e:position
    e set_void_result
  var Arrow adp
  if e:size>=3
   e:2 compile ?
   var Pointer:Type ptype :> e:2:result:type
   var Link:Expression type_id :> expression ident ptype:name near e:2
   if copy
      ef :> expression immediat (new ptype pvalue) substitute ptype type_id substitute pvalue e:2 near e
      adp := ef evaluate
   else
      adp := e:2 evaluate
   if error_notified
      return
   if adp=null
      error error_id_unexpected "Failed to evaluate expression at "+e:position
      e set_void_result
  if (addressof e:module:external)=null
     var Link:Argument adr :> argument constant Address addressof:(e:module)
  else
     var Link:Argument adr :> argument constant Address addressof:(e:module:external)
  var Link:Argument ma :> argument indirect Module adr 0
  e add (instruction (the_function declare_filter2 Module Str Address Arrow) ma (argument constant Str e:0:ident) (argument constant Address ad) (argument constant Arrow adp))
  e set_void_result
#
# generic parse_text parser filter
# parameter is assumed to be a string corresponding to the keyword used.
# If parameter is "foo", then
#   foo a b c
#     hello
#    How are you ?
#       this morning...
#
# will be parsed as if written
#
#   foo a b c
#    " hello"
#    "How are you ?"
#    "   this morning..."
#

function parse_text context line parameter
  arg_rw ParserContext context ; arg Str line ; arg Address parameter
  var Pointer:Str kwd :> parameter map Str
  if (line 0 kwd:len)=kwd
    var Int x := 0
    var Pointer:Str l :> context:current_line map Str
    while l:x = " "
       x+=1
    var Pointer:Arrow cur :> context:text next context:current_line
    while cur<>null and { var Pointer:Str l :> cur map Str ; (l 0 x+1)=(repeat x+1 " ") or l=(repeat l:len " ") }
      var Str t := l x+1 l:len
      l := (repeat x+1 " ")+string:t
      cur :> context:text next cur

#
# simple multi-line text meta
#
# syntax:
# inline_text [leftcut|ignorefirst]
#   some text
#    over multiple lines...
#
meta inline_text e
  if e:size<1
     return
  var Link:Expression body :> e e:size-1
  if body:ident<>"{}" or body:size=0
     return
  for (var Int i) 0 body:size-1
     var Address ad := body:i constant Str
     if ad=null
        error error_id_unexpected "text: argument #"+string:i+" is not a constant Str"
        return
  var Bool leftcut := false; var Int leftmargin:=0; var Int start:=0
  var Str s
  if e:size>1 and e:0:is_pure_ident
   if e:0:ident="leftcut"
     leftcut:=true
     leftmargin := -1 # stands for infinity
   eif e:0:ident="ignorefirst"
     start := 1
     var Pointer:Str ss :> (body:0 constant Str) map Str
     ss eparse spaces:s
     leftmargin := s:len
  if leftcut
    for (var Int i) 0 body:size-1
       var Pointer:Str ss :> (body:i constant Str) map Str
       ss eparse spaces:s
       if s:len<leftmargin or leftmargin<0
         leftmargin:=s:len
  s:=""
  for (var Int i) start body:size-1
    var Pointer:Str ss :> (body:i constant Str) map Str
    s += (ss leftmargin ss:len)+"[lf]"
  e set_result (argument constant Str s) access_read

#
# filter declaration for immediat use
#
declare_filter 'pliant parser basic types' parse_text "inline_text" copy