140 lines
		
	
	
		
			3.6 KiB
		
	
	
	
		
			Factor
		
	
	
			
		
		
	
	
			140 lines
		
	
	
		
			3.6 KiB
		
	
	
	
		
			Factor
		
	
	
! Copyright (C) 2007 Robbert van Dalen.
 | 
						|
! See http://factorcode.org/license.txt for BSD license.
 | 
						|
 | 
						|
IN: enchilada.parser
 | 
						|
USING: strings sequences kernel promises lazy-lists parser-combinators parser-combinators.simple isequences.interface isequences.base enchilada.engine ;
 | 
						|
 | 
						|
USE: lazy-lists
 | 
						|
USE: parser-combinators
 | 
						|
 | 
						|
DEFER: e-expression
 | 
						|
 | 
						|
LAZY: e/- ( -- parser )
 | 
						|
    "-" token [ drop <.-> ] <@ ;
 | 
						|
 | 
						|
LAZY: e/# ( -- parser )
 | 
						|
    "#" token [ drop <.#> ] <@ ;
 | 
						|
 | 
						|
LAZY: e/^ ( -- parser )
 | 
						|
    "^" token [ drop <.^> ] <@ ;
 | 
						|
 | 
						|
LAZY: e/` ( -- parser )
 | 
						|
    "`" token [ drop <.`> ] <@ ;
 | 
						|
 | 
						|
LAZY: e/: ( -- parser )
 | 
						|
    ":" token [ drop <.:> ] <@ ;
 | 
						|
 | 
						|
LAZY: e/~ ( -- parser )
 | 
						|
    "~" token [ drop <.~> ] <@ ;
 | 
						|
 | 
						|
LAZY: e/$ ( -- parser )
 | 
						|
    "$" token [ drop <.$> ] <@ ;
 | 
						|
 | 
						|
LAZY: e/! ( -- parser )
 | 
						|
    "!" token [ drop <.!> ] <@ ;
 | 
						|
 | 
						|
LAZY: e/\ ( -- parser )
 | 
						|
    "\\" token [ drop <.\> ] <@ ;
 | 
						|
 | 
						|
LAZY: e/+ ( -- parser )
 | 
						|
    "+" token [ drop <.+> ] <@ ;
 | 
						|
 | 
						|
LAZY: e/| ( -- parser )
 | 
						|
    "|" token [ drop <.|> ] <@ ;
 | 
						|
 | 
						|
LAZY: e/& ( -- parser )
 | 
						|
    "&" token [ drop <.&> ] <@ ;
 | 
						|
 | 
						|
LAZY: e/* ( -- parser )
 | 
						|
    "*" token [ drop <.*> ] <@ ;
 | 
						|
 | 
						|
LAZY: e// ( -- parser )
 | 
						|
    "/" token [ drop <./> ] <@ ;
 | 
						|
 | 
						|
LAZY: e/< ( -- parser )
 | 
						|
    "<" token [ drop <.<> ] <@ ;
 | 
						|
 | 
						|
LAZY: e/> ( -- parser )
 | 
						|
    ">" token [ drop <.>> ] <@ ;
 | 
						|
 | 
						|
LAZY: e/@ ( -- parser )
 | 
						|
    "@" token [ drop <.@> ] <@ ;
 | 
						|
 | 
						|
LAZY: e/? ( -- parser )
 | 
						|
    "?" token [ drop <.?> ] <@ ;
 | 
						|
 | 
						|
LAZY: e/% ( -- parser )
 | 
						|
    "%" token [ drop <.%> ] <@ ;
 | 
						|
 | 
						|
LAZY: e-monadic ( -- parser )
 | 
						|
    e/- e/# <|> e/^ <|> e/` <|> e/: <|> e/~ <|> e/$ <|> e/! <|> e/\ <|> ;
 | 
						|
 | 
						|
LAZY: e-dyadic ( -- parser )
 | 
						|
    e/+ e/* <|> e/& <|> e/| <|> e// <|> e/< <|> e/> <|> e/@ <|> e/? <|> e/% <|> ;
 | 
						|
 | 
						|
LAZY: e-number ( -- parser )
 | 
						|
    'integer' ;
 | 
						|
 | 
						|
LAZY: e-letter ( -- parser )
 | 
						|
    [ letter? ] satisfy [ 1 swap <string> ] <@ ;
 | 
						|
 | 
						|
LAZY: e-digit ( -- parser )
 | 
						|
    [ digit? ] satisfy [ 1 swap <string> ] <@ ;
 | 
						|
 | 
						|
LAZY: e-alphanumeric-char ( -- parser )
 | 
						|
    e-letter e-digit <|> ;
 | 
						|
 | 
						|
LAZY: e-alphanumeric-symbol ( -- parser )
 | 
						|
    e-letter e-alphanumeric-char <!*> <&> [ dup first swap second "" [ append ] reduce append ] <@ ;
 | 
						|
 | 
						|
LAZY: e-symbol ( -- parser )
 | 
						|
    e-alphanumeric-symbol 'string' <|> sp [ <esymbol> ] <@ ;
 | 
						|
 | 
						|
LAZY: e-symbol-list ( -- parser )
 | 
						|
    e-symbol <!+> [ { } [ ++ ] reduce ] <@ ;
 | 
						|
 | 
						|
LAZY: e-macro-expression ( -- parser )
 | 
						|
    "=" token "=" token <?> <&> sp e-expression <&> [ dup 1 tail swap first second [ t ] [ f ] if add ] <@ ;
 | 
						|
 | 
						|
LAZY: e-macro ( -- parser )
 | 
						|
    "{" token sp e-symbol-list &> e-macro-expression <?> <&> "}" token sp <& 
 | 
						|
    [ dup first swap second dup [ first ] [ drop { 0 f } ] if dup first swap second <e-macro> ] <@ ;
 | 
						|
 | 
						|
LAZY: e-right-expression ( -- parser )
 | 
						|
    "=" token e-expression &> ;
 | 
						|
 | 
						|
: create-e-item ( pair -- e-item )
 | 
						|
    dup first swap second dup [ first ] [ drop 0 ] if <i-dual-sided> <i> ;
 | 
						|
 
 | 
						|
LAZY: e-item ( -- parser )
 | 
						|
e-expression e-right-expression <?> <&> [ create-e-item ] <@ ;
 | 
						|
 | 
						|
LAZY: e-rest ( -- parser )
 | 
						|
";" token sp e-item &> <!*> [ { } [ ++ ] reduce ] <@ ;
 | 
						|
 | 
						|
LAZY: e-contents ( -- parser )
 | 
						|
e-item e-rest <&> [ dup first swap second ++ ] <@ ;
 | 
						|
 | 
						|
LAZY: e-non-empty ( -- parser )
 | 
						|
"[" token e-contents &> "]" token sp <& ;
 | 
						|
 | 
						|
LAZY: e-empty ( -- parser )
 | 
						|
    "[" token "]" token <&> [ drop 0 ] <@ ;
 | 
						|
 | 
						|
LAZY: e-sequence ( -- parser )
 | 
						|
    e-empty e-non-empty <|> e-number <|> ;
 | 
						|
 | 
						|
LAZY: e-operand ( -- parser )
 | 
						|
    "_" token <?> e-sequence <&> [ dup second swap first [ -- ] when <i> ] <@ ;
 | 
						|
 | 
						|
LAZY: e-operator ( -- parser )
 | 
						|
    e-monadic e-dyadic <|> e-macro <|>  ;
 | 
						|
 | 
						|
LAZY: e-element ( -- parser )
 | 
						|
    e-operator e-operand <|> e-symbol <|> sp ;
 | 
						|
 | 
						|
LAZY: e-expression ( -- parser )
 | 
						|
    e-element <!*> [ { } [ ++ ] reduce ] <@ ;
 | 
						|
 | 
						|
: e-parse  ( string -- result ) e-expression parse car parse-result-parsed ;
 |