2006-08-06 20:31:29 -04:00
|
|
|
#! An interpreter for lambda expressions, by Matthew Willis
|
2006-08-09 01:57:56 -04:00
|
|
|
REQUIRES: lazy-lists ;
|
|
|
|
USING: lazy-lists io strings hashtables sequences kernel ;
|
2006-08-06 20:31:29 -04:00
|
|
|
IN: lambda
|
|
|
|
|
2006-08-09 01:57:56 -04:00
|
|
|
#! every expression has a canonical representation of this form
|
|
|
|
: bound-variables-list ( -- lazy-list ) 65 lfrom [ ch>string ] lmap ;
|
2006-08-06 20:31:29 -04:00
|
|
|
|
2006-08-09 01:57:56 -04:00
|
|
|
TUPLE: linterp names reps ;
|
|
|
|
: (lint>string) ( linterp expr -- linterp )
|
|
|
|
bound-variables-list swap expr>string over dupd linterp-reps hash
|
|
|
|
", " join ":" append swap append "=> " swap append ;
|
2006-08-06 20:31:29 -04:00
|
|
|
|
2006-08-09 01:57:56 -04:00
|
|
|
: update-names ( names-hash name expr -- names-hash )
|
|
|
|
swap rot [ set-hash ] keep ;
|
2006-08-06 20:31:29 -04:00
|
|
|
|
2006-08-09 01:57:56 -04:00
|
|
|
C: linterp ( names-hash )
|
|
|
|
#! take a names hash, and generate the reverse lookup hash from it.
|
|
|
|
#! TODO: make this really ugly code cleaner
|
|
|
|
2dup set-linterp-names swap H{ } clone [ swap hash>alist
|
|
|
|
[ [ first ] keep second bound-variables-list swap expr>string rot
|
|
|
|
[ hash ] 2keep rot dup not [ drop rot { } swap add -rot ]
|
|
|
|
[ >r rot r> swap add -rot ] if set-hash ] each-with ] keep
|
|
|
|
swap [ set-linterp-reps ] keep ;
|
2006-08-06 20:31:29 -04:00
|
|
|
|
2006-08-09 01:57:56 -04:00
|
|
|
: lint-read ( -- input )
|
|
|
|
readln [ "." = ] keep swap ;
|
2006-08-06 20:31:29 -04:00
|
|
|
|
2006-08-09 01:57:56 -04:00
|
|
|
: lint-eval ( linterp input -- linterp name expr )
|
|
|
|
lambda-parse [ first ] keep second pick linterp-names swap replace-names
|
|
|
|
evaluate ;
|
2006-08-06 20:31:29 -04:00
|
|
|
|
2006-08-09 01:57:56 -04:00
|
|
|
: lint>string ( linterp name expr -- linterp )
|
|
|
|
rot linterp-names -rot [ update-names ] keep [ <linterp> ] dip
|
|
|
|
(lint>string) ;
|
2006-08-06 20:31:29 -04:00
|
|
|
|
2006-08-09 01:57:56 -04:00
|
|
|
: lint-print ( linterp name expr -- linterp )
|
|
|
|
lint>string print flush ;
|
2006-08-06 20:31:29 -04:00
|
|
|
|
2006-08-09 01:57:56 -04:00
|
|
|
: lint-boot ( -- initial-names )
|
|
|
|
H{ } clone <linterp> ;
|
2006-08-06 20:31:29 -04:00
|
|
|
|
2006-08-09 01:57:56 -04:00
|
|
|
: (lint) ( linterp -- linterp )
|
2006-08-09 02:02:50 -04:00
|
|
|
lint-read [ drop ] [ lint-eval lint-print (lint) ] if ;
|
2006-08-06 20:31:29 -04:00
|
|
|
|
2006-08-09 01:57:56 -04:00
|
|
|
: lint ( -- linterp )
|
|
|
|
lint-boot (lint) ;
|