core/strings/parser/parser.factor

   1 ! Copyright (C) 2008 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: kernel summary assocs namespaces splitting sequences
   4 strings math.parser lexer ;
   5 IN: strings.parser
   6
   7 ERROR: bad-escape ;
   8
   9 M: bad-escape summary drop "Bad escape code" ;
  10
  11 : escape ( escape -- ch )
  12     H{
  13         { CHAR: a  CHAR: \a }
  14         { CHAR: e  CHAR: \e }
  15         { CHAR: n  CHAR: \n }
  16         { CHAR: r  CHAR: \r }
  17         { CHAR: t  CHAR: \t }
  18         { CHAR: s  CHAR: \s }
  19         { CHAR: \s CHAR: \s }
  20         { CHAR: 0  CHAR: \0 }
  21         { CHAR: \\ CHAR: \\ }
  22         { CHAR: \" CHAR: \" }
  23     } at [ bad-escape ] unless* ;
  24
  25 SYMBOL: name>char-hook
  26
  27 name>char-hook global [
  28     [ "Unicode support not available" throw ] or
  29 ] change-at
  30
  31 : unicode-escape ( str -- ch str' )
  32     "{" ?head-slice [
  33         CHAR: } over index cut-slice
  34         >r >string name>char-hook get call r>
  35         rest-slice
  36     ] [
  37         6 cut-slice >r hex> r>
  38     ] if ;
  39
  40 : next-escape ( str -- ch str' )
  41     "u" ?head-slice [
  42         unicode-escape
  43     ] [
  44         unclip-slice escape swap
  45     ] if ;
  46
  47 : (parse-string) ( str -- m )
  48     dup [ "\"\\" member? ] find dup [
  49         >r cut-slice >r % r> rest-slice r>
  50         dup CHAR: " = [
  51             drop slice-from
  52         ] [
  53             drop next-escape >r , r> (parse-string)
  54         ] if
  55     ] [
  56         "Unterminated string" throw
  57     ] if ;
  58
  59 : parse-string ( -- str )
  60     lexer get [
  61         [ swap tail-slice (parse-string) ] "" make swap
  62     ] change-lexer-column ;