basis/multiline/multiline.factor

   1 ! Copyright (C) 2007 Daniel Ehrenberg
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: namespaces make parser lexer kernel sequences words
   4 quotations math accessors locals ;
   5 IN: multiline
   6
   7 ERROR: bad-heredoc identifier ;
   8
   9 <PRIVATE
  10
  11 : rest-of-line ( -- seq )
  12     lexer get [ line-text>> ] [ column>> ] bi tail ;
  13
  14 : next-line-text ( -- str )
  15     lexer get [ next-line ] [ line-text>> ] bi ;
  16
  17 : (parse-here) ( -- )
  18     next-line-text [
  19         dup ";" =
  20         [ drop lexer get next-line ]
  21         [ % "\n" % (parse-here) ] if
  22     ] [ ";" throw-unexpected-eof ] if* ;
  23
  24 PRIVATE>
  25
  26 ERROR: text-found-before-eol string ;
  27
  28 : parse-here ( -- str )
  29     [
  30         rest-of-line dup [ drop ] [ text-found-before-eol ] if-empty
  31         (parse-here)
  32     ] "" make but-last ;
  33
  34 SYNTAX: STRING:
  35     scan-new-word
  36     parse-here 1quotation
  37     ( -- string ) define-inline ;
  38
  39 <PRIVATE
  40
  41 : lexer-eof? ( lexer -- ? )
  42     [ line>> ] [ text>> length ] bi <= ;
  43
  44 :: (scan-multiline-string) ( i end -- j )
  45     lexer get line-text>> :> text
  46     lexer get lexer-eof? [
  47         end text i start* [| j |
  48             i j text subseq % j end length +
  49         ] [
  50             text i short tail % CHAR: \n ,
  51             lexer get next-line
  52             0 end (scan-multiline-string)
  53         ] if*
  54     ] [ end throw-unexpected-eof ] if ;
  55
  56 :: (parse-multiline-string) ( end-text skip-n-chars -- str )
  57     [
  58         lexer get
  59         [ skip-n-chars + end-text (scan-multiline-string) ]
  60         change-column drop
  61     ] "" make ;
  62
  63 :: advance-same-line ( text -- )
  64     lexer get [ text length + ] change-column drop ;
  65
  66 :: (parse-til-line-begins) ( begin-text -- )
  67     lexer get still-parsing? [
  68         lexer get line-text>> begin-text sequence= [
  69             begin-text advance-same-line
  70         ] [
  71             lexer get line-text>> % "\n" %
  72             lexer get next-line
  73             begin-text (parse-til-line-begins)
  74         ] if
  75     ] [
  76         begin-text bad-heredoc
  77     ] if ;
  78
  79 : parse-til-line-begins ( begin-text -- seq )
  80     [ (parse-til-line-begins) ] "" make ;
  81
  82 PRIVATE>
  83
  84 : parse-multiline-string ( end-text -- str )
  85     1 (parse-multiline-string) ;
  86
  87 SYNTAX: /* "*/" parse-multiline-string drop ;
  88
  89 SYNTAX: HEREDOC:
  90     lexer get skip-blank
  91     rest-of-line
  92     lexer get next-line
  93     parse-til-line-begins suffix! ;
  94
  95 SYNTAX: DELIMITED:
  96     lexer get skip-blank
  97     rest-of-line
  98     lexer get next-line
  99     0 (parse-multiline-string) suffix! ;