Skip to content

Commit

Permalink
* Grammar: Allow [] in CgOp as synonym forms for ().
Browse files Browse the repository at this point in the history 
* settings: Rewrite (prog (...) (...)) forms into (prog [...] [...]) for readability.
  • Loading branch information
Audrey Tang committed Jul 20, 2010
1 parent c9d4a66 commit f98b0b1
Show file tree
Hide file tree
Showing 2 changed files with 85 additions and 85 deletions.
6 changes: 3 additions & 3 deletions Niecza/Grammar.pm6
View file
Expand Up @@ -30,13 +30,13 @@ grammar CgOp is STD {
token category:cgexp { <sym> }
proto token cgexp { <...> }

token cgopname { <-[ ' " ( ) \s ]> + }
token cgopname { <-[ ' " ( ) \[ \] \s ]> + }

token cgexp:op { '(':s {} <cgopname> [ <cgexp> ]* ')' }
token cgexp:op { <[ ( \[ ]>:s {} <cgopname> [ <cgexp> ]* <[ ) \] ]> }
token cgexp:name { <cgopname> }
token cgexp:quote { <?before <[ ' " ]>> {} [ :lang(%*LANG<MAIN>) <quote> ] }
token cgexp:decint { <decint> }
token cgexp:bad { <!before ')'> {}
token cgexp:bad { <!before <[ ) \] ]> > {}
[ <?stdstopper> <.panic "Missing cgop"> ]
<.panic: "Unparsable cgop">
}
Expand Down
164 changes: 82 additions & 82 deletions setting
View file
Expand Up @@ -33,80 +33,80 @@ PRE-INIT {
# ClassHOW.new($name) --> meta class instance
sub new { Q:CgOp {
(prog
(lextypes $mo DynMetaObject $self DynObject)
(l $mo (rawnew DynMetaObject (unwrap String (@ (pos 1)))))
(l $self (rawnew DynObject (getfield klass
(cast DynObject (@ (pos 0))))))
[lextypes $mo DynMetaObject $self DynObject]
[l $mo (rawnew DynMetaObject (unwrap String (@ (pos 1))))]
[l $self (rawnew DynObject (getfield klass
(cast DynObject (@ (pos 0)))))]
(setfield how (l $mo) (l $self))
(setindex meta-object (getfield slots (l $self))
(nsw (rawnew CLRImportObject (l $mo))))
[setfield how (l $mo) (l $self)]
[setindex meta-object (getfield slots (l $self))
(nsw (rawnew CLRImportObject (l $mo)))]
(ns (l $self)))
[ns (l $self)])
} }
# $how.add-super($how)
sub add-super { Q:CgOp { (prog
(rawcall
[rawcall
(getfield superclasses (unwrap DynMetaObject
(getattr meta-object (@ (pos 0))))) Add
(unwrap DynMetaObject (getattr meta-object (@ (pos 1)))))
(null Variable))
(unwrap DynMetaObject (getattr meta-object (@ (pos 1))))]
[null Variable])
} }

# $how.add-method($name, $sub)
sub add-method { Q:CgOp {
(prog
(setindex (unwrap String (@ (pos 1)))
[setindex (unwrap String (@ (pos 1)))
(getfield local (unwrap DynMetaObject (getattr meta-object
(@ (pos 0)))))
(@ (pos 2)))
(@ (pos 2))]
(null Variable))
[null Variable])
} }
# $how.create-protoobject()
sub create-protoobject { Q:CgOp {
(prog
(lextypes $p DynObject $mo DynMetaObject)
(l $mo (unwrap DynMetaObject (getattr meta-object (@ (pos 0)))))
(l $p (rawnew DynObject (l $mo)))
[lextypes $p DynObject $mo DynMetaObject]
[l $mo (unwrap DynMetaObject (getattr meta-object (@ (pos 0))))]
[l $p (rawnew DynObject (l $mo))]

(rawcall (l $mo) BuildC3MRO)
[rawcall (l $mo) BuildC3MRO]

(setfield slots (l $p) (null Dictionary<string,object>))
(setfield typeObject (l $mo) (l $p))
[setfield slots (l $p) (null Dictionary<string,object>)]
[setfield typeObject (l $mo) (l $p)]

(newscalar (l $p)))
[newscalar (l $p)])
} }

sub compose { Q:CgOp { (null Variable) } }
Q:CgOp {
(prog
(lextypes $chmo DynMetaObject $chch Variable)
(l $chmo (rawnew DynMetaObject (clr_string "ClassHOW")))
(l $chch (ns (rawnew DynObject (l $chmo))))

(setfield how (l $chmo) (@ (l $chch)))
(setindex meta-object (getfield slots (cast DynObject (@ (l $chch))))
(w (l $chmo)))

(sink (subcall (@ (l &add-method)) (l $chch)
(wrap (clr_string "new")) (l &new)))
(sink (subcall (@ (l &add-method)) (l $chch)
(wrap (clr_string "add-method")) (l &add-method)))
(sink (subcall (@ (l &add-method)) (l $chch)
(wrap (clr_string "add-super")) (l &add-super)))
(sink (subcall (@ (l &add-method)) (l $chch)
(wrap (clr_string "compose")) (l &compose)))
(sink (subcall (@ (l &add-method)) (l $chch)
(wrap (clr_string "create-protoobject")) (l &create-protoobject)))

(l ClassHOW (subcall (@ (l &create-protoobject)) (l $chch)))
(l ClassHOW!HOW (l $chch))

(null Variable))
[lextypes $chmo DynMetaObject $chch Variable]
[l $chmo (rawnew DynMetaObject (clr_string "ClassHOW"))]
[l $chch (ns (rawnew DynObject (l $chmo)))]

[setfield how (l $chmo) (@ (l $chch))]
[setindex meta-object (getfield slots (cast DynObject (@ (l $chch))))
(w (l $chmo))]

[sink (subcall (@ (l &add-method)) (l $chch)
(wrap (clr_string "new")) (l &new))]
[sink (subcall (@ (l &add-method)) (l $chch)
(wrap (clr_string "add-method")) (l &add-method))]
[sink (subcall (@ (l &add-method)) (l $chch)
(wrap (clr_string "add-super")) (l &add-super))]
[sink (subcall (@ (l &add-method)) (l $chch)
(wrap (clr_string "compose")) (l &compose))]
[sink (subcall (@ (l &add-method)) (l $chch)
(wrap (clr_string "create-protoobject")) (l &create-protoobject))]

[l ClassHOW (subcall (@ (l &create-protoobject)) (l $chch))]
[l ClassHOW!HOW (l $chch)]

[null Variable])
}
}

Expand All @@ -121,43 +121,43 @@ PRE-INIT {
# (DynMetaObject $dmo, ClassHOW $super --> ClassHOW)
sub wrap-dpmo { Q:CgOp {
(prog
(lextypes $ch Variable $dm DynMetaObject)
(l $ch (methodcall (l ClassHOW) new (w (clr_string ""))))
(l $dm (unwrap DynMetaObject (@ (pos 0))))
(assign (varattr meta-object (@ (l $ch))) (w (l $dm)))
(setfield how (l $dm) (@ (l $ch)))
(sink (methodcall (l $ch) add-super (pos 1)))
(l $ch))
[lextypes $ch Variable $dm DynMetaObject]
[l $ch (methodcall (l ClassHOW) new (w (clr_string "")))]
[l $dm (unwrap DynMetaObject (@ (pos 0)))]
[assign (varattr meta-object (@ (l $ch))) (w (l $dm))]
[setfield how (l $dm) (@ (l $ch))]
[sink (methodcall (l $ch) add-super (pos 1))]
[l $ch])
} }
Q:CgOp {
(prog
(lextypes !plist List<DynMetaObject>)
[lextypes !plist List<DynMetaObject>]

(l Mu!HOW (methodcall (l ClassHOW) new (w (clr_string Mu))))
(l Mu (methodcall (l Mu!HOW) create-protoobject))
[l Mu!HOW (methodcall (l ClassHOW) new (w (clr_string Mu)))]
[l Mu (methodcall (l Mu!HOW) create-protoobject)]

(l Any!HOW (methodcall (l ClassHOW) new (w (clr_string Any))))
(sink (methodcall (l Any!HOW) add-super (l Mu!HOW)))
(l Any (methodcall (l Any!HOW) create-protoobject))
[l Any!HOW (methodcall (l ClassHOW) new (w (clr_string Any)))]
[sink (methodcall (l Any!HOW) add-super (l Mu!HOW))]
[l Any (methodcall (l Any!HOW) create-protoobject)]

(l Cool!HOW (methodcall (l ClassHOW) new (w (clr_string Cool))))
(sink (methodcall (l Cool!HOW) add-super (l Any!HOW)))
(l Cool (methodcall (l Cool!HOW) create-protoobject))
[l Cool!HOW (methodcall (l ClassHOW) new (w (clr_string Cool)))]
[sink (methodcall (l Cool!HOW) add-super (l Any!HOW))]
[l Cool (methodcall (l Cool!HOW) create-protoobject)]

(sink (methodcall (l ClassHOW!HOW) add-super (l Any!HOW)))
(rawcall (getfield klass (cast DynObject (@ (l ClassHOW)))) BuildC3MRO)
[sink (methodcall (l ClassHOW!HOW) add-super (l Any!HOW))]
[rawcall (getfield klass (cast DynObject (@ (l ClassHOW)))) BuildC3MRO]

(l Sub!HOW (subcall (@ (l &wrap-dpmo))
(w (rawsget Kernel.SubMO)) (l Any!HOW)))
(l Sub (methodcall (l Sub!HOW) create-protoobject))
[l Sub!HOW (subcall (@ (l &wrap-dpmo))
(w (rawsget Kernel.SubMO)) (l Any!HOW))]
[l Sub (methodcall (l Sub!HOW) create-protoobject)]

(l Scalar!HOW (subcall (@ (l &wrap-dpmo))
(w (rawsget Kernel.ScalarMO)) (l Any!HOW)))
(l Scalar (methodcall (l Scalar!HOW) create-protoobject))
[l Scalar!HOW (subcall (@ (l &wrap-dpmo))
(w (rawsget Kernel.ScalarMO)) (l Any!HOW))]
[l Scalar (methodcall (l Scalar!HOW) create-protoobject)]

(null Variable))
[null Variable])
} }

my class Junction is Mu { }
Expand Down Expand Up @@ -256,13 +256,13 @@ sub infix:<< != >>($l,$r) { Q:CgOp {
} }
sub say($str) { Q:CgOp {
(prog (rawscall Console.WriteLine
(unbox String (fetch (methodcall (scopedlex $str) Str))))
(box Bool (bool 1))
(prog [rawscall Console.WriteLine
(unbox String (fetch (methodcall (scopedlex $str) Str))])
[box Bool (bool 1)]
)
} }

sub infix:<=> { Q:CgOp { (prog (assign (pos 0) (pos 1)) (pos 0)) } }
sub infix:<=> { Q:CgOp { (prog [assign (pos 0) (pos 1)] (pos 0)) } }
# Buglet in STD: standard infix operators look custom inside the setting, and
# forget their precedence.
Expand Down Expand Up @@ -371,16 +371,16 @@ PRE-INIT {
# boxes a List<Variable>. SCHLIEMEL WAS HERE
my class LLArray {
method push($x) { Q:CgOp { (prog
(rawcall (unbox List<Variable> (@ (l self))) Add (l $x)) (l self)) } }
[rawcall (unbox List<Variable> (@ (l self))) Add (l $x)] [l self]) } }
method shift() { Q:CgOp { (prog
(lextypes $f Variable $lv List<Variable>)
(l $lv (unbox List<Variable> (@ (l self))))
(l $f (getindex (int 0) (l $lv)))
(rawcall (l $lv) RemoveAt (int 0))
(l $f)) } }
[lextypes $f Variable $lv List<Variable>]
[l $lv (unbox List<Variable> (@ (l self)))]
[l $f (getindex (int 0) (l $lv))]
[rawcall (l $lv) RemoveAt (int 0)]
[l $f]) } }
method unshift($x) { Q:CgOp { (prog
(rawcall (unbox List<Variable> (@ (l self))) Insert (int 0) (l $x))
(l self)) } }
[rawcall (unbox List<Variable> (@ (l self))) Insert (int 0) (l $x)]
[l self]) } }
method first-flattens() { Q:CgOp {
(box Bool (getfield islist (getfield lv (getindex (int 0)
(unbox List<Variable> (@ (l self))))))) } }
Expand Down

0 comments on commit f98b0b1

Please sign in to comment.