--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PPCCompiler.st Mon Sep 07 08:20:46 2015 +0100
@@ -0,0 +1,304 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+Object subclass:#PPCCompiler
+ instanceVariableNames:'context ir history passes'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Core'
+!
+
+
+!PPCCompiler class methodsFor:'as yet unclassified'!
+
+default
+ ^ self universal
+!
+
+new
+ ^ self basicNew
+ initialize;
+ yourself
+!
+
+tokenizing
+ | options |
+
+ options := PPCCompilationOptions default.
+ options tokenize:true.
+ ^ (PPCCompiler new)
+ options:options;
+ yourself
+
+ "Modified: / 04-09-2015 / 16:21:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+universal
+ | options |
+
+ options := PPCCompilationOptions default.
+ options tokenize:false.
+ ^ (PPCCompiler new)
+ options:options;
+ yourself
+
+ "Modified: / 04-09-2015 / 16:21:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!PPCCompiler methodsFor:'accessing'!
+
+context
+ ^ context
+!
+
+options
+ ^ context options
+
+ "Modified: / 26-08-2015 / 19:48:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+options: aPPCCompilationOptions
+ context options: aPPCCompilationOptions
+
+ "Created: / 26-08-2015 / 19:56:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+passes
+ ^ passes
+!
+
+passes:aCollection
+ passes := aCollection asOrderedCollection
+
+ "Modified: / 04-09-2015 / 14:14:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!PPCCompiler methodsFor:'accessing - defaults'!
+
+defaultPassesForTokenizingParser
+ ^ {
+ PPCTokenDetector .
+ PPCCacheFirstFollowPass .
+ PPCLL1Visitor .
+ PPCTokenizingVisitor .
+ PPCMergingVisitor .
+ PPCSpecializingVisitor .
+ PPCInliningVisitor .
+ PPCMergingVisitor .
+ PPCCheckingVisitor .
+ PPCCacheFirstFollowPass .
+ PPCTokenizingCodeGenerator .
+ PPCFSAVisitor .
+ PPCTokenCodeGenerator .
+ PPCScannerCodeGenerator .
+ } asOrderedCollection.
+
+ "Created: / 04-09-2015 / 15:56:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+defaultPassesForUniversalParser
+ ^ {
+ PPCTokenDetector.
+ PPCCacheFirstFollowPass.
+ PPCSpecializingVisitor .
+ PPCRecognizerComponentDetector .
+ PPCSpecializingVisitor .
+ PPCInliningVisitor .
+ PPCMergingVisitor .
+ PPCCheckingVisitor .
+ PPCUniversalCodeGenerator
+ } asOrderedCollection.
+
+ "Created: / 04-09-2015 / 15:56:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!PPCCompiler methodsFor:'adding / removing passes'!
+
+removePass: pass
+ | index |
+
+ self initializePassesIfNotAlready.
+ [
+ index := passes indexOf: pass.
+ index ~~ 0
+ ] whileTrue:[
+ passes removeAtIndex: index
+ ].
+
+ "Created: / 04-09-2015 / 11:24:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 04-09-2015 / 16:02:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!PPCCompiler methodsFor:'compiling'!
+
+compile: aPPParser
+ | time |
+ self input: aPPParser.
+
+ time := [ self compile ] timeToRun.
+ ((Smalltalk respondsTo:#isSmalltalkX) and:[Smalltalk isSmalltalkX]) ifFalse:[
+ "Assume Pharo"
+ time := time asMilliSeconds.
+ ].
+ self reportTime: time.
+
+ ^ ir
+
+ "Modified: / 17-08-2015 / 13:06:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!PPCCompiler methodsFor:'initialization'!
+
+initialize
+ history := OrderedCollection new.
+ context := PPCCompilationContext new.
+
+ "Modified: / 04-09-2015 / 15:56:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+initializePassesIfNotAlready
+ passes isNil ifTrue:[
+ context options tokenize ifTrue:[
+ passes := self defaultPassesForTokenizingParser
+ ] ifFalse:[
+ passes := self defaultPassesForUniversalParser
+ ].
+ ].
+
+ "Created: / 04-09-2015 / 16:02:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!PPCCompiler methodsFor:'private'!
+
+buildClass: clazz
+ | builder |
+ builder := PPCClassBuilder new.
+
+ builder compiledClassName: clazz name.
+ builder compiledSuperclass: clazz superclass.
+ builder methodDictionary: clazz methodDictionary.
+ builder constants: clazz constants.
+
+ ^ builder compileClass.
+!
+
+compile
+ self runPasses.
+ self generateScanner.
+ self generateParser.
+
+ "Modified: / 07-09-2015 / 07:53:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+copyTree: somethingTransformable
+ ^ somethingTransformable transform: [ :e | e copy ]
+!
+
+generateParser
+ | parserClass parserSuper rootMethod |
+
+ context options generate ifFalse:[
+ ^ self
+ ].
+ context parserClass methodDictionary isEmpty ifTrue:[
+ ^ self
+ ].
+
+ parserSuper := context options parserSuperclass.
+ parserSuper isNil ifTrue:[
+ parserSuper := context options tokenize
+ ifTrue:[ PPTokenizingCompiledParser ]
+ ifFalse:[ PPCompiledParser ]
+ ].
+ rootMethod := context parserClass propertyAt:#rootMethod.
+ context parserClass name:context options parserName.
+ context parserClass superclass: parserSuper.
+ parserClass := self buildClass:context parserClass.
+ parserClass startSymbol:rootMethod methodName.
+ self remember:parserClass as:#parser.
+ ir := parserClass new
+
+ "Modified: / 25-08-2015 / 00:05:49 / Jan Vrany"
+ "Modified: / 04-09-2015 / 16:07:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+generateScanner
+ | scanner |
+
+ context options generate ifFalse:[
+ ^ self
+ ].
+ context scannerClass methodDictionary isEmpty ifTrue:[
+ ^ self
+ ].
+
+ context scannerClass name:context options scannerName.
+ context scannerClass superclass:context options scannerSuperclass.
+ scanner := (self buildClass:context scannerClass).
+ context parserClass addConstant:scanner as:#scannerClass.
+ ir := scanner.
+ self remember:scanner as:#scanner
+
+ "Modified: / 25-08-2015 / 00:06:49 / Jan Vrany"
+ "Modified: / 04-09-2015 / 15:33:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+input: aPPParser
+ ir := aPPParser asCompilerTree.
+ self remember: (self copyTree: ir) as: #input
+
+ "Modified (format): / 29-08-2015 / 07:18:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+ir
+ ^ ir
+!
+
+ir: whatever
+ ir := whatever
+!
+
+remember: value as: key
+ context options debug ifTrue: [
+ history add: key -> value.
+ ]
+
+ "Modified: / 28-08-2015 / 14:14:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+reportTime: timeInMs
+ context options profile ifTrue: [
+ Transcript show: 'Time to compile: '; show: timeInMs asString; show: ' ms'; cr.
+ ]
+
+ "Modified: / 07-09-2015 / 07:55:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+runPasses
+ self initializePassesIfNotAlready.
+ passes do:[:each | self runPass: each ]
+
+ "Created: / 07-09-2015 / 07:53:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!PPCCompiler methodsFor:'running'!
+
+runPass: pass
+ | p |
+
+ p := pass asPPCPass.
+ ir := p run: ir in: context.
+ self remember:(self copyTree:ir) as:p class name
+
+ "Created: / 26-08-2015 / 22:35:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 29-08-2015 / 07:16:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!PPCCompiler class methodsFor:'documentation'!
+
+version_HG
+
+ ^ '$Changeset: <not expanded> $'
+! !
+