Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
Implement quoted identifiers, some more class stuff
  • Loading branch information
@sorear
sorear committed Jul 7, 2010
1 parent 81429e4 commit 1c21454
Show file tree
Hide file tree
Showing 4 changed files with 71 additions and 64 deletions.
2 changes: 1 addition & 1 deletion CodeGen.pm
View file
Expand Up @@ -18,7 +18,7 @@ use 5.010;

DynProtoMetaObject =>
{ how => 'IP6',
local => 'Dictionary<String,DynMetaObject.Method>',
local => 'Dictionary<String,DynProtoMetaObject.Method>',
def_outers => 'List<Frame>',
name => 'String' },

Expand Down
34 changes: 23 additions & 11 deletions Niecza/Actions.pm
View file
Expand Up @@ -284,7 +284,7 @@ sub up { my ($cl, $M) = @_;
}

sub lexdecl { my ($cl, $M) = @_;
$M->{_ast} = [ map { $_->Str, $M->{clrid}->Str } @{ $M->{varid} } ];
$M->{_ast} = [ map { $_->{_ast}, $M->{clrid}->Str } @{ $M->{varid} } ];
}

# :: [row of NIL op]
Expand All @@ -294,11 +294,11 @@ sub insn__S_lextypes { my ($cl, $M) = @_;
}

sub insn__S_clone_lex { my ($cl, $M) = @_;
$M->{_ast} = [ map { [ clone_lex => $_->Str ] } @{ $M->{varid} } ];
$M->{_ast} = [ map { [ clone_lex => $_->{_ast} ] } @{ $M->{varid} } ];
}

sub insn__S_copy_lex { my ($cl, $M) = @_;
$M->{_ast} = [ map { [ copy_lex => $_->Str ] } @{ $M->{varid} } ];
$M->{_ast} = [ map { [ copy_lex => $_->{_ast} ] } @{ $M->{varid} } ];
}

sub insn__S_string_var { my ($cl, $M) = @_;
Expand All @@ -325,15 +325,15 @@ sub insn__S_goto { my ($cl, $M) = @_;
}

sub insn__S_lex { my ($cl, $M) = @_;
$M->{_ast} = [[ lex => $M->{up}{_ast}, $M->{varid}->Str ]];
$M->{_ast} = [[ lex => $M->{up}{_ast}, $M->{varid}{_ast} ]];
}

sub insn__S_lexget { my ($cl, $M) = @_;
$M->{_ast} = [[ lexget => $M->{up}{_ast}, $M->{varid}->Str ]];
$M->{_ast} = [[ lexget => $M->{up}{_ast}, $M->{varid}{_ast} ]];
}

sub insn__S_lexput { my ($cl, $M) = @_;
$M->{_ast} = [[ lexput => $M->{up}{_ast}, $M->{varid}->Str ]];
$M->{_ast} = [[ lexput => $M->{up}{_ast}, $M->{varid}{_ast} ]];
}

sub insn__S_how { my ($cl, $M) = @_;
Expand Down Expand Up @@ -382,19 +382,19 @@ sub insn__S_new { my ($cl, $M) = @_;
}

sub insn__S_clr_field_get { my ($cl, $M) = @_;
$M->{_ast} = [[ clr_field_get => $M->{varid}->Str ]];
$M->{_ast} = [[ clr_field_get => $M->{varid}{_ast} ]];
}

sub insn__S_clr_field_set { my ($cl, $M) = @_;
$M->{_ast} = [[ clr_field_set => $M->{varid}->Str ]];
$M->{_ast} = [[ clr_field_set => $M->{varid}{_ast} ]];
}

sub insn__S_clr_index_get { my ($cl, $M) = @_;
$M->{_ast} = [[ clr_index_get => ($M->{varid}[0] ? ($M->{varid}[0]->Str) : ()) ]];
$M->{_ast} = [[ clr_index_get => ($M->{varid}[0] ? ($M->{varid}[0]{_ast}) : ()) ]];
}

sub insn__S_clr_index_set { my ($cl, $M) = @_;
$M->{_ast} = [[ clr_index_set => ($M->{varid}[0] ? ($M->{varid}[0]->Str) : ()) ]];
$M->{_ast} = [[ clr_index_set => ($M->{varid}[0] ? ($M->{varid}[0]{_ast}) : ()) ]];
}

sub insn__S_cast { my ($cl, $M) = @_;
Expand All @@ -410,7 +410,18 @@ sub insn__S_push_null { my ($cl, $M) = @_;
}

sub clrid {}
sub varid {}
sub clrqual {}
sub clrgeneric {}
sub varid { my ($cl, $M) = @_;
if ($M->{quote}) {
if (!$M->{quote}{_ast}->isa('Op::StringLiteral')) {
$M->sorry("Strings used in NIL code must be compile time constants");
}
$M->{_ast} = $M->{quote}{_ast}->text;
} else {
$M->{_ast} = $M->Str;
}
}
sub apostrophe {}
sub quibble {}
sub tribble {}
Expand Down Expand Up @@ -546,6 +557,7 @@ sub package_def { my ($cl, $M) = @_;
}
# allocate a slot
$::CURLEX->{'!slots'}{$M->{decl}{name}} = 1;
$::CURLEX->{'!slots'}{$M->{decl}{name} . "!HOW"} = 1;
}

sub routine_declarator {}
Expand Down
5 changes: 4 additions & 1 deletion Niecza/Grammar.pm6
View file
Expand Up @@ -32,7 +32,10 @@ grammar NIL is STD {
token category:insn { <sym> }
proto token insn { <...> }

token varid { [ <sigil> <twigil>? ]? <identifier> }
token varid {
[ <sigil> <twigil>? ]? <identifier> |
<?before "'"> [ :lang(%*LANG<main>) <quote> ]
}

token clrid { <ident>**'.' <clrgeneric>? <clrqual>* }
token clrgeneric { '<' <clrid>**',' '>' }
Expand Down
94 changes: 43 additions & 51 deletions setting
View file
Expand Up @@ -41,73 +41,65 @@
my class ClassHOW { ... }

PRE-INIT {
# Constructs a ClassHOW object for an existing DynProtoMetaObject
# Takes the metaclass' DynMetaObject as a dependency injection
sub wrap-metaclass { # $metaclass-mo, $mpo
Q:NIL {
LEXICALS: mci, p: DynObject, mpo: DynProtoMetaObject

new/0:DynObject L!mci
=[1] @ unwrap:DynProtoMetaObject L!mpo
new/0:DynObject L!p2

L@p L@mo !.klass

L@mo L@mci !.how

L@mci @.slots L@mo ![meta-object]
L@mci @.slots L@p ![prototype]

L@mci =[0] @ unwrap:DynMetaObject !.klass

L@p .plaincall/1:Kernel.NewROVar
}
}
# ClassHOW.new($name) --> meta class instance
sub new { Q:NIL {
LEXICALS: $pmo : DynProtoMetaObject, $self : DynObject
new/0:DynProtoMetaObject L!$pmo
new/0:DynObject L!$self

=begin comment
sub new-metaclass { Q:NIL {
LEXICALS: mo: DynMetaObject
new/0:DynMetaObject L!mo
L@mo =[1] @ unwrap:String !.name
L@^&wrap-metaclass @ =[0]
L@mo new/1:CLRImportObject .plaincall/1:Kernel.NewROVar
.tailcall/2
} }
L@$pmo L@$self !.how
L@$pmo =[1] @ unwrap:String !.name
L@$self @.slots L@$pmo ![metaobject]

sub new { Q:NIL {
L@^&new-metaclass @
=[0] @ cast:DynObject @.klass new/1:CLRImportObject
.plaincall/1:Kernel.NewROVar
=[1] .tailcall/2
L@$self .plaincall/1:Kernel.NewROVar
} }

# $how.push-scope($outer)
sub push-scope { Q:NIL {
=[0] @ cast:DynObject @.slots @[meta-object] cast:DynMetaObject @.outers
=[1] @ unwrap:Frame .virtcall/1:Add
=[0] @ cast:DynObject @.slots @[meta-object] cast:DynProtoMetaObject
@.def_outers =[1] @ unwrap:Frame .virtcall/1:Add
null:Variable
} }

# $how.add-scoped-method($name, $index, $sub)
sub add-scoped-method { Q:NIL {
=[0] @ cast:DynObject @.slots @[meta-object] cast:DynMetaObject @.local
=[1] @ unwrap:String
=[3] @ cast:DynObject @.slots @[code] cast:DynBlockDelegate
=[3] @ cast:DynObject @.slots @[proto] cast:Frame
=[1] @ unwrap:Int32 new/3:DynMetaObject.Method
![]
LEXICALS: $name : String, $index : Int32, $sub : DynObject
LEXICALS: $mo : DynProtoMetaObject
=[0] @ cast:DynObject @.slots @[meta-object] cast:DynMetaObject L!$mo
=[1] @ unwrap:String L!$name
=[2] @ unwrap:Int32 L!$index
=[3] @ cast:DynObject L!$sub

LEXICALS: $proto : Frame, $code : DynBlockDelegate
L@$sub @.slots @[code] cast:DynBlockDelegate L!$code
L@$sub @.slots @[proto] cast:Frame L!$proto

LEXICALS: $m : DynProtoMetaObject.Method
L@$code L@$proto L@$index new/3:DynProtoMetaObject.Method L!$m

L@$mo @.local L@$name L@$m ![]
null:Variable
} }

Q:NIL {
LEXICALS: $p: Variable
L@&new-metaclass @ null:DynMetaObject new/1:CLRImportObject
.plaincall/1:Kernel.NewROVar ="ClassHOW" .call/2 L!$p
# $how.create-protoobject($callframe)
sub create-protoobject { Q:NIL {
LEXICALS: $p : DynObject, $pmo : DynProtoMetaObject, $mo : DynMetaObject
new/0:DynObject L!$p
=[0] @ cast:DynObject @.slots @[meta-object] L!$pmo
L@$pmo new/1:DynMetaObject L!$mo
L@$mo @.outers =[1] @ unwrap:Frame .virtcall/1:Add

L@$p @ how cast:DynObject L@$p @ cast:DynObject @.klass !.klass
L@$p null:Dictionary<string,object> !.slots
L@$p L@$mo !.klass

L@$p L!^ClassHOW
L@$p .plaincall/1:Kernel.NewROVar
} }

sub compose { Q:NIL { null:Variable } }

Q:NIL {
null:Variable
}
=end comment
}

sub infix:<~> { Q:NIL {
Expand Down

0 comments on commit 1c21454

Please sign in to comment.